This Prolog Life bindingt_mw14292 https://binding-time.co.uk/index.php/This_Prolog_Life MediaWiki 1.42.3 first-letter Media Special Talk User User talk this prolog life this prolog life talk File File talk MediaWiki MediaWiki talk Template Template talk Help Help talk Category Category talk 0 2 2 2013-06-01T23:41:04Z WikiSysop 1 Created page with "__NOTOC__ ==Problem Definition== We are given 12 apparently identical coins - one of which is counterfeit. We know that the counterfeit has a different weight from the others..." wikitext text/x-wiki __NOTOC__ ==Problem Definition== We are given 12 apparently identical coins - one of which is counterfeit. We know that the counterfeit has a different weight from the others, but we don't know if it's heavier or lighter. ===Task:=== Devise a procedure to identify any counterfeit coin using a balance to take up to three comparative weighings. ==Strategy== The information from three suitable weighings will make all but one of the 'coins', which are untested initially, 'known true'. There are three alternative deductions that make a coin 'known true': * if it is 'not heavy' and 'not light' - having been on both the comparatively lighter and heavier sides of imbalances; * if it was excluded from an imbalance; * if it was included in a balanced weighing. After three weighings there must be exactly one coin, the counterfeit, which is not 'true'. If the counterfeit is not true and 'not heavy' we deduce that it must be light. If it is not true and 'not light', it must be heavy. We use a 'generate-and-test' method as follows: * Create the set of all possible 'counterfeits': 12 coins &times; 2 weights ; * Devise a procedure that can identify the first counterfeit coin; * Show that the same procedure works for every other counterfeit. ==Entry Point== ====go==== is the entry point. It solves the puzzle, then uses a DCG to pretty-print the resulting procedure. <syntaxhighlight lang="prolog"> go :- coins_puzzle( Procedure ), phrase( general_explanation( Procedure ), Chars ), put_chars( Chars ). </syntaxhighlight> ====coins_puzzle( ?Procedure )==== generates the set of all possible 'counterfeits' and finds (or proves) that <var>Procedure</var> can identify them all. <syntaxhighlight lang="prolog"> coins_puzzle( Procedure ) :- coins( Coins ), counterfeit( Counterfeit, Coin, Weight ), findall( Counterfeit, (member(Coin,Coins), counterfeit_weight(Weight)), Counterfeits ), coins_puzzle_solution( Counterfeits, Procedure ). coins_puzzle_solution( [], _Procedure ). coins_puzzle_solution( [Counterfeit|Counterfeits], Procedure ) :- solve_coins( Counterfeit, Procedure ), coins_puzzle_solution( Counterfeits, Procedure ). </syntaxhighlight> A procedure is either 'done', identifying a particular coin and whether it is 'heavy' or 'light'; or it is a 'step'. A step defines the coins to be placed on the <var>Left</var> and <var>Right</var> pans, with the residue remaining on the <var>Table</var>, and three <var>Branches</var>, one of which will be chosen depending on the outcome of the weighing. <syntaxhighlight lang="prolog"> step( step(Left,Right,Table,Branches), Left, Right, Table, Branches). </syntaxhighlight> The <var>Branches</var> are three procedures equating to: * > (left pan heavier), * < (right pan heavier) and * <nowiki>= (pans balance).</nowiki> <syntaxhighlight lang="prolog"> branch( >, branches(_Equal, GT, _LT), GT ). branch( <, branches(_Equal, _GT, LT), LT ). branch( =, branches(Equal, _GT, _LT), Equal ). </syntaxhighlight> The counterfeit is defined by its number and whether it is heavy or light. <syntaxhighlight lang="prolog"> counterfeit( counterfeit(Coin, HeavyOrLight), Coin, HeavyOrLight ). coins( [1,2,3,4,5,6,7,8,9,10,11,12] ). counterfeit_weight( heavy ). counterfeit_weight( light ). </syntaxhighlight> A 'coin collection' comprise four 'parts' (subsets): the <code>known_true</code>, <code>not_heavy</code>, <code>not_light</code> and <code>untested</code> sets of coins. <syntaxhighlight lang="prolog"> part( known_true, collection(Coins,_,_,_), Coins ). part( not_heavy, collection(_,Coins,_,_), Coins ). part( not_light, collection(_,_,Coins,_), Coins ). part( untested, collection(_,_,_,Coins), Coins ). </syntaxhighlight> ==Solution== ====solve_coins( +Counterfeit, ?Procedure )==== holds when <var> Procedure</var> can correctly identify the <var>Counterfeit</var> coin. Beginning with a 'start' collection, in which all the coins are untested, the <var>Procedure</var> comprises three 'steps'. For each step a 'weighing' is made and a 'branch' is made in the <var>Procedure</var>, depending on the result of the weighing. After three steps, the <var>Procedure</var> must have reached the 'end' condition. Finally, an assertion (redundant test) ensures that the <var> Procedure</var> has found the correct end condition. <syntaxhighlight lang="prolog"> solve_coins( Counterfeit, Procedure ) :- start( Coins0 ), assay( Counterfeit, Coins0, Procedure, Branch1, Coins1 ), assay( Counterfeit, Coins1, Branch1, Branch2, Coins2 ), assay( Counterfeit, Coins2, Branch2, done(Coin, HeavyOrLight), Coins3 ), end( Coins3, Coin, HeavyOrLight ), counterfeit( Counterfeit, Coin, HeavyOrLight ). start( Coins ) :- coins( Untested ), part( untested, Coins, Untested ), part( not_heavy, Coins, [] ), part( not_light, Coins, [] ), part( known_true, Coins, [] ). end( Coins, Coin, HeavyOrLight ) :- part( untested, Coins, [] ), part( not_heavy, Coins, Light ), part( not_light, Coins, Heavy ), end_result( Heavy, Light, Coin, HeavyOrLight ). end_result( [Coin], [], Coin, heavy ). end_result( [], [Coin], Coin, light ). </syntaxhighlight> === Simulating the weighing process === ====assay( +Counterfeit, +Coins0, ?Step, ?Branch, ?Coins1 )==== holds when the appropriate <var>Branch</var> from <var>Step</var> is chosen by comparing the weights of two coin collections taken from the full set of coins: <var>Coins0</var>. <var>Coins1</var> is the full set of coins, updated with the inferences drawn from the weighing. <var>Counterfeit</var> is used to determine the result of the weighing. This predicate applies the critical insight into the solution of this puzzle: we have 24 (12 &times; 2) possible inputs to the procedure, with only 27 (3 &times; 3 &times; 3) possible outcomes from the weighings. Therefore, it is clear that each weighing must have a very high 'information content' &mdash; choosing a weighing by information content makes the problem tractable. <syntaxhighlight lang="prolog"> assay( Counterfeit, Coins0, Step, Branch, Coins ) :- WeighingDatum = weighing_data(InfoContent, Left, Right, Table), step( Step, Left, Right, Table, Branches ), findall( WeighingDatum, valid_partition( Coins0, InfoContent, Left, Right, Table ), WeighingData ), sort( WeighingData, OrderedWeighingData ), member( WeighingDatum, OrderedWeighingData ), balance( Left, Right, Counterfeit, Result ), draw_inferences( Result, Left, Right, Table, Coins ), branch( Result, Branches, Branch ). </syntaxhighlight> ====balance( +Left, +Right, +Counterfeit, ? Result )==== holds when <var>Result</var> simulates the outcome of testing the coin collections <var>Left</var> and <var>Right</var> with a balance, where either may contain the <var>Counterfeit</var> coin. <syntaxhighlight lang="prolog"> balance( Left, Right, Counterfeit, Result ):- counterfeit( Counterfeit, Coin, Weight ), ( contains_coin( Left, Coin ) -> balance_result( Weight, normal, Result ) ; contains_coin( Right, Coin ) -> balance_result( normal, Weight, Result ) ; otherwise -> Result = '=' ). balance_result( light, normal, < ). balance_result( heavy, normal, > ). balance_result( normal, heavy, < ). balance_result( normal, light, > ). </syntaxhighlight> ===Choosing which coins to weigh=== ====valid_partition( +Coins, ?Content, ?Left, ?Right, ?Table )==== holds when <var>Coins</var> can be partitioned into three collections: <var>Left</var> side, <var>Right</var> side and <var>Table</var>; with the 'information content' of the partition given by <var>Content</var>. The definition of a 'valid partition' ensures that: * <var>Left</var> and <var>Right</var> must have the same number of coins (at least one); * <var>Left</var> cannot contain any known 'true' coins, because adding true coins to both sides creates redundant comparisons. A 'checksum' is used to ensure that only one member of each pair of symmetrical solutions can be generated. <syntaxhighlight lang="prolog"> valid_partition( Coins, Content, Left, Right, Table ):- part( known_true, Left, [] ), selection( Coins, Left, Coins1, Count, LeftChecksum, LeftInfo ), Count >= 1, selection( Coins1, Right, Table, Count, RightChecksum, RightInfo ), LeftChecksum =< RightChecksum, % Checksum to prevent symmetrical solutions table_information( Table, TableInfo ), sum( [LeftInfo,RightInfo,TableInfo], Content ). </syntaxhighlight> ====selection( +Coins, ?Sample, ?Residue, ?Count, ?Checksum, ?Content )==== holds when <var>Coins</var> is partitioned into two collections: <var>Sample</var> and <var>Residue</var>. <var>Count</var> is the number of coins in <var>Sample</var>. <var>Checksum</var> is a fingerprint for the mixture of coins in <var>Sample</var>, which has 'information content' <var>Content</var>. <syntaxhighlight lang="prolog"> selection( Coins, Sample, Residue, Count, Checksum, Content ) :- select_coins( not_heavy, Coins, Sample, Residue, Count1 ), select_coins( not_light, Coins, Sample, Residue, Count2 ), select_coins( untested, Coins, Sample, Residue, Count3 ), select_coins( known_true, Coins, Sample, Residue, Count4 ), Count is Count1+Count2+Count3+Count4, Count =< 6, Checksum is Count1+(7*Count2)+(43*Count3)+(259*Count4), information_content( [Count1,Count2,Count3,Count4], Content ). table_information( Coins, Content ) :- count_coins( not_heavy, Coins, Count1 ), count_coins( not_light, Coins, Count2 ), count_coins( untested, Coins, Count3 ), count_coins( known_true, Coins, Count4 ), information_content( [Count1,Count2,Count3,Count4], Content ). count_coins( Part, Coins, Count ) :- part( Part, Coins, Selection ), length( Selection, Count ). </syntaxhighlight> === Updating what is known about the coins === ====draw_inferences( +Result, +Left, +Right, +Table, ?Coins )==== holds when <var>Result</var> is one of: * > (imbalance - left pan heavier), * < (imbalance - right pan heavier) or * <nowiki>=</nowiki> (pans balanced) from taking a weighing with the coin collections: <var>Left</var>, <var> Right</var> and <var>Table</var>. <var>Coins</var> is derived from this information using the following rules: * If the pans are unbalanced then only the previously untested or not_heavy coins on the lighter side of the balance are now not_heavy. Similarly, only the previously untested or not_light coins on the heavier side of the balance are now not_light. All the coins on the table are now known_true. * If the pans balance then all the coins weighed are known_true, with the coins on the <var>Table</var> left in their prior states. <syntaxhighlight lang="prolog"> draw_inferences( <, Left, Right, Table, Coins ) :- imbalance_inferences( Left, Right, Table, Coins ). draw_inferences( >, Left, Right, Table, Coins ) :- imbalance_inferences( Right, Left, Table, Coins ). draw_inferences( =, Left, Right, Table, Coins ) :- inference( [all(Left),known_true(Table),all(Right)], known_true( Coins ) ), inference( untested(Table), untested(Coins) ), inference( not_heavy(Table), not_heavy(Coins) ), inference( not_light(Table), not_light(Coins) ). </syntaxhighlight> ====imbalance_inferences( +Lighter, +Heavier, +Table, ?Coins )==== holds when: * All untested or not_heavy coins in <var>Lighter</var> are not_heavy in <var>Coins </var>; * All untested or not_light coins in <var>Heavier</var> are not_light in <var>Coins </var>; * All coins in <var>Table</var> are known_true in <var>Coins</var>; There are no untested coins in <var>Coins</var>. <syntaxhighlight lang="prolog"> imbalance_inferences( Lighter, Heavier, Table, Coins ) :- inference( [untested(Lighter),not_heavy(Lighter)], not_heavy(Coins) ), inference( [untested(Heavier),not_light(Heavier)], not_light(Coins) ), inference( [ known_true(Lighter), not_light(Lighter), known_true(Heavier), not_heavy(Heavier), all(Table) ], known_true(Coins) ), part( untested, Coins, [] ). </syntaxhighlight> ====inference( +CollectionA, ?CollectionB )==== holds when (part) <var>CollectionB</var> comprises the same coins as (part) <var>CollectionA</var>. <syntaxhighlight lang="prolog"> inference( CollectionA, CollectionB ) :- unfolded( CollectionA, Coins ), unfolded( CollectionB, Coins ). </syntaxhighlight> ====unfolded( +Collection, ?Coins )==== holds when (part) <var>Collection</var> comprises <var>Coins</var>. <syntaxhighlight lang="prolog"> unfolded( not_light(Collection), Coins ) :- part( not_light, Collection, Coins ). unfolded( not_heavy(Collection), Coins ) :- part( not_heavy, Collection, Coins ). unfolded( known_true(Collection), Coins ) :- part( known_true, Collection, Coins ). unfolded( untested(Collection), Coins ) :- part( untested, Collection, Coins ). unfolded( all(Collection), Coins ) :- collection_to_set( Collection, Coins ). unfolded( [Item|Items], Coins ) :- unfolded( Item, Value ), unfolded1( Items, Value, Coins ). unfolded1( [], Coins, Coins ). unfolded1( [Item|Items], Value, Coins ) :- unfolded( Item, Value0 ), ord_union( Value0, Value, Value1 ), unfolded1( Items, Value1, Coins ). </syntaxhighlight> ==Definite Clause Grammar== The following DCG represents the method for finding the counterfeit coin as a 'structured' procedure. <syntaxhighlight lang="prolog"> general_explanation( Procedure ) --> "Number the coins 1..12", newline, explanation( Procedure, 0 ). explanation( done(Coin, Weight), N ) --> tab( N ), "Conclude that the counterfeit coin is number ", literal( Coin ), ", which is ", literal( Weight ), newline. explanation( Step, N ) --> {step( Step, Left, Right, Table, Branches )}, tab( N ), "BEGIN", newline, tab( N ), "Put ", literal( Left ), " on the left-hand pan", newline, tab( N ), "Put ", literal( Right ), " on the right-hand pan", newline, tab( N ), "Leaving ", literal( Table ), " on the table", newline, branches_explained( Branches, N ), tab( N ), "END", newline. branches_explained( Branches, N ) --> next_step_explained( <, Branches, N ), next_step_explained( >, Branches, N ), next_step_explained( =, Branches, N ). next_step_explained( Result, Branch, N ) --> {branch( Result, Branch, Step )}, ( {var(Step)} -> "" | {nonvar(Step)} -> tab( N ), "If the ", literal( Result ), " then:", newline, explanation( Step, s(N) ) ). literal( 0 ) --> "0". literal( 1 ) --> "1". literal( 2 ) --> "2". literal( 3 ) --> "3". literal( 4 ) --> "4". literal( 5 ) --> "5". literal( 6 ) --> "6". literal( 7 ) --> "7". literal( 8 ) --> "8". literal( 9 ) --> "9". literal( 10 ) --> "10". literal( 11 ) --> "11". literal( 12 ) --> "12". literal( true ) --> "true". literal( heavy ) --> "heavy". literal( light ) --> "light". literal( = ) --> "pans balance". literal( < ) --> "right-hand pan is heavier". literal( > ) --> "left-hand pan is heavier". literal( Collection ) --> {collection_to_set( Collection , [H|T] )}, literal_set( T, H ). literal_set( [], Number ) --> "the coin numbered ", literal( Number ). literal_set( [H|T], Number ) --> "the coins numbered ", literal( Number ), literal_set1( T, H ). literal_set1( [], Number ) --> " and ", literal( Number ). literal_set1( [H|T], Number ) --> ", ", literal( Number ), literal_set1( T, H ). tab( 0 ) --> "". tab( s(N) ) --> " ", tab( N ). newline --> " ". </syntaxhighlight> ===Utility Predicates=== ====contains_coin( ?Collection, ?Coin )==== holds when <var>Coin</var> is a member of <var>Collection</var>. <syntaxhighlight lang="prolog"> contains_coin( Collection, Coin ) :- part( _Part, Collection, Coins ), member( Coin, Coins ). </syntaxhighlight> ====collection_to_set( +Collection, ?Set )==== holds when <var>Set</var> is the distributed union of the <code>known_true</code>, <code>not_heavy</code>, <code>not_light</code> and <code>untested</code> ordsets comprising <var>Collection</var>. <syntaxhighlight lang="prolog"> collection_to_set( Collection, Set ) :- part( known_true, Collection, KnownTrue ), part( not_heavy, Collection, NotHeavy ), part( not_light, Collection, NotLight ), part( untested, Collection, Untested ), ord_union( [KnownTrue,NotHeavy,NotLight,Untested], Set ). </syntaxhighlight> ==== information_content( +Counts, ?Content ) ==== holds when <var>Content</var> is the cumulative negative entropy of <var>Counts</var>. A reduction in entropy equates to a gain in information. <syntaxhighlight lang="prolog"> information_content( Counts, Content ) :- information_content1( Counts, 0, Content ). information_content1( [], Content, Content ). information_content1( [Count|Counts], Content0, Content ):- coins_entropy( Count, Entropy ), Content1 is Content0-Entropy, information_content1( Counts, Content1, Content ). </syntaxhighlight> ==== coins_entropy( ?N, ?Entropy ) ==== holds when <var>Entropy</var> estimates the entropy of a sample of <var>N</var> coins. <var>Entropy</var> = P log₂1/P, where P = <var>N</var>/12. <syntaxhighlight lang="prolog"> coins_entropy( 0, 0.0 ). coins_entropy( 1, 0.2987 ). coins_entropy( 2, 0.4308 ). coins_entropy( 3, 0.5 ). coins_entropy( 4, 0.5283 ). coins_entropy( 5, 0.5263 ). coins_entropy( 6, 0.5 ). coins_entropy( 7, 0.4536 ). coins_entropy( 8, 0.39 ). coins_entropy( 9, 0.3113 ). coins_entropy( 10, 0.2192 ). coins_entropy( 11, 0.1151 ). coins_entropy( 12, 0.0 ). </syntaxhighlight> ====select_coins( +Part, +Count, ?Sample, ?Residue, ?Coins )==== <syntaxhighlight lang="prolog"> select_coins( Part, Coins, Sample, Residue, Count ) :- part( Part, Coins, Input ), part( Part, Sample, Selection ), part( Part, Residue, Remainder ), select_n( Count, Input, Selection, Remainder ). select_n( 0, In, [], In ). select_n( 1, [A|Suffix], [A], Suffix ). select_n( 2, [A,B|Suffix], [A,B], Suffix ). select_n( 3, [A,B,C|Suffix], [A,B,C], Suffix ). select_n( 4, [A,B,C,D|Suffix], [A,B,C,D], Suffix ). select_n( 5, [A,B,C,D,E|Suffix], [A,B,C,D,E], Suffix ). select_n( 6, [A,B,C,D,E,F|Suffix], [A,B,C,D,E,F], Suffix ). </syntaxhighlight> Load a small library of [puzzle utilities.] <syntaxhighlight lang="prolog"> :- ensure_loaded( misc ). </syntaxhighlight> Use the ordsets library. <syntaxhighlight lang="prolog"> :- use_module( library(ordsets), [ord_union/2,ord_union/3] ). </syntaxhighlight> ==Output== <div class="result"> Number the coins 1..12 BEGIN Put the coins numbered 1, 2, 3 and 4 on the left-hand pan Put the coins numbered 5, 6, 7 and 8 on the right-hand pan Leaving the coins numbered 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 1, 2, 5 and 6 on the left-hand pan Put the coins numbered 3, 7, 9 and 10 on the right-hand pan Leaving the coins numbered 4, 8, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 1 and 7 on the left-hand pan Put the coins numbered 3 and 4 on the right-hand pan Leaving the coins numbered 2, 5, 6, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 1, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 7, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 2, which is light END If the left-hand pan is heavier then: BEGIN Put the coins numbered 3 and 5 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 4, 6, 7, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 3, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 5, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 6, which is heavy END If the pans balance then: BEGIN Put the coins numbered 4 and 8 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 3, 5, 6, 7, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 4, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 8, which is heavy END END If the left-hand pan is heavier then: BEGIN Put the coins numbered 1, 2, 5 and 6 on the left-hand pan Put the coins numbered 3, 7, 9 and 10 on the right-hand pan Leaving the coins numbered 4, 8, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 3 and 5 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 4, 6, 7, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 5, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 3, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 6, which is light END If the left-hand pan is heavier then: BEGIN Put the coins numbered 1 and 7 on the left-hand pan Put the coins numbered 3 and 4 on the right-hand pan Leaving the coins numbered 2, 5, 6, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 7, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 1, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 2, which is heavy END If the pans balance then: BEGIN Put the coins numbered 4 and 8 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 3, 5, 6, 7, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 8, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 4, which is heavy END END If the pans balance then: BEGIN Put the coins numbered 9, 10 and 11 on the left-hand pan Put the coins numbered 1, 2 and 3 on the right-hand pan Leaving the coins numbered 4, 5, 6, 7, 8 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coin numbered 9 on the left-hand pan Put the coin numbered 10 on the right-hand pan Leaving the coins numbered 1, 2, 3, 4, 5, 6, 7, 8, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 9, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 10, which is light If the pans balance then: Conclude that the counterfeit coin is number 11, which is light END If the left-hand pan is heavier then: BEGIN Put the coin numbered 9 on the left-hand pan Put the coin numbered 10 on the right-hand pan Leaving the coins numbered 1, 2, 3, 4, 5, 6, 7, 8, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 10, which is heavy If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 9, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 11, which is heavy END If the pans balance then: BEGIN Put the coin numbered 12 on the left-hand pan Put the coin numbered 1 on the right-hand pan Leaving the coins numbered 2, 3, 4, 5, 6, 7, 8, 9, 10 and 11 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 12, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 12, which is heavy END END END </div> ---- b552b3356856150beb0489e5e0c0b5f7239ad198 12 2 2013-06-21T22:32:24Z John 2 /* coins_puzzle( ?Procedure ) */ wikitext text/x-wiki __NOTOC__ ==Problem Definition== We are given 12 apparently identical coins - one of which is counterfeit. We know that the counterfeit has a different weight from the others, but we don't know if it's heavier or lighter. ===Task:=== Devise a procedure to identify any counterfeit coin using a balance to take up to three comparative weighings. ==Strategy== The information from three suitable weighings will make all but one of the 'coins', which are untested initially, 'known true'. There are three alternative deductions that make a coin 'known true': * if it is 'not heavy' and 'not light' - having been on both the comparatively lighter and heavier sides of imbalances; * if it was excluded from an imbalance; * if it was included in a balanced weighing. After three weighings there must be exactly one coin, the counterfeit, which is not 'true'. If the counterfeit is not true and 'not heavy' we deduce that it must be light. If it is not true and 'not light', it must be heavy. We use a 'generate-and-test' method as follows: * Create the set of all possible 'counterfeits': 12 coins &times; 2 weights ; * Devise a procedure that can identify the first counterfeit coin; * Show that the same procedure works for every other counterfeit. ==Entry Point== ====go==== is the entry point. It solves the puzzle, then uses a DCG to pretty-print the resulting procedure. <syntaxhighlight lang="prolog"> go :- coins_puzzle( Procedure ), phrase( general_explanation( Procedure ), Chars ), put_chars( Chars ). </syntaxhighlight> ====coins_puzzle( ?Procedure )==== generates the set of all possible 'counterfeits' and finds (or proves) that <var>Procedure</var> can identify them all. <syntaxhighlight lang="prolog"> coins_puzzle( Procedure ) :- coins( Coins ), counterfeit( Counterfeit, Coin, Weight ), findall( Counterfeit, (member(Coin,Coins), counterfeit_weight(Weight)), Counterfeits ), coins_puzzle_solution( Counterfeits, Procedure ). coins_puzzle_solution( [], _Procedure ). coins_puzzle_solution( [Counterfeit|Counterfeits], Procedure ) :- solve_coins( Counterfeit, Procedure ), coins_puzzle_solution( Counterfeits, Procedure ). </syntaxhighlight> A procedure is either 'done', identifying a particular coin and whether it is 'heavy' or 'light'; or it is a 'step'. A step defines the coins to be placed on the <var>Left</var> and <var>Right</var> pans, with the residue remaining on the <var>Table</var>, and three <var>Branches</var>, one of which will be chosen depending on the outcome of the weighing. <syntaxhighlight lang="prolog"> step( step(Left,Right,Table,Branches), Left, Right, Table, Branches). </syntaxhighlight> The <var>Branches</var> are three procedures equating to: * > (left pan heavier), * < (right pan heavier) and * <nowiki>= (pans balance).</nowiki> <syntaxhighlight lang="prolog"> branch( >, branches(_Equal, GT, _LT), GT ). branch( <, branches(_Equal, _GT, LT), LT ). branch( =, branches(Equal, _GT, _LT), Equal ). </syntaxhighlight> The counterfeit is defined by its number and whether it is heavy or light. <syntaxhighlight lang="prolog"> counterfeit( counterfeit(Coin, HeavyOrLight), Coin, HeavyOrLight ). coins( [1,2,3,4,5,6,7,8,9,10,11,12] ). counterfeit_weight( heavy ). counterfeit_weight( light ). </syntaxhighlight> A 'coin collection' comprises four 'parts' (subsets): the <code>known_true</code>, <code>not_heavy</code>, <code>not_light</code> and <code>untested</code> sets of coins. <syntaxhighlight lang="prolog"> part( known_true, collection(Coins,_,_,_), Coins ). part( not_heavy, collection(_,Coins,_,_), Coins ). part( not_light, collection(_,_,Coins,_), Coins ). part( untested, collection(_,_,_,Coins), Coins ). </syntaxhighlight> ==Solution== ====solve_coins( +Counterfeit, ?Procedure )==== holds when <var> Procedure</var> can correctly identify the <var>Counterfeit</var> coin. Beginning with a 'start' collection, in which all the coins are untested, the <var>Procedure</var> comprises three 'steps'. For each step a 'weighing' is made and a 'branch' is made in the <var>Procedure</var>, depending on the result of the weighing. After three steps, the <var>Procedure</var> must have reached the 'end' condition. Finally, an assertion (redundant test) ensures that the <var> Procedure</var> has found the correct end condition. <syntaxhighlight lang="prolog"> solve_coins( Counterfeit, Procedure ) :- start( Coins0 ), assay( Counterfeit, Coins0, Procedure, Branch1, Coins1 ), assay( Counterfeit, Coins1, Branch1, Branch2, Coins2 ), assay( Counterfeit, Coins2, Branch2, done(Coin, HeavyOrLight), Coins3 ), end( Coins3, Coin, HeavyOrLight ), counterfeit( Counterfeit, Coin, HeavyOrLight ). start( Coins ) :- coins( Untested ), part( untested, Coins, Untested ), part( not_heavy, Coins, [] ), part( not_light, Coins, [] ), part( known_true, Coins, [] ). end( Coins, Coin, HeavyOrLight ) :- part( untested, Coins, [] ), part( not_heavy, Coins, Light ), part( not_light, Coins, Heavy ), end_result( Heavy, Light, Coin, HeavyOrLight ). end_result( [Coin], [], Coin, heavy ). end_result( [], [Coin], Coin, light ). </syntaxhighlight> === Simulating the weighing process === ====assay( +Counterfeit, +Coins0, ?Step, ?Branch, ?Coins1 )==== holds when the appropriate <var>Branch</var> from <var>Step</var> is chosen by comparing the weights of two coin collections taken from the full set of coins: <var>Coins0</var>. <var>Coins1</var> is the full set of coins, updated with the inferences drawn from the weighing. <var>Counterfeit</var> is used to determine the result of the weighing. This predicate applies the critical insight into the solution of this puzzle: we have 24 (12 &times; 2) possible inputs to the procedure, with only 27 (3 &times; 3 &times; 3) possible outcomes from the weighings. Therefore, it is clear that each weighing must have a very high 'information content' &mdash; choosing a weighing by information content makes the problem tractable. <syntaxhighlight lang="prolog"> assay( Counterfeit, Coins0, Step, Branch, Coins ) :- WeighingDatum = weighing_data(InfoContent, Left, Right, Table), step( Step, Left, Right, Table, Branches ), findall( WeighingDatum, valid_partition( Coins0, InfoContent, Left, Right, Table ), WeighingData ), sort( WeighingData, OrderedWeighingData ), member( WeighingDatum, OrderedWeighingData ), balance( Left, Right, Counterfeit, Result ), draw_inferences( Result, Left, Right, Table, Coins ), branch( Result, Branches, Branch ). </syntaxhighlight> ====balance( +Left, +Right, +Counterfeit, ? Result )==== holds when <var>Result</var> simulates the outcome of testing the coin collections <var>Left</var> and <var>Right</var> with a balance, where either may contain the <var>Counterfeit</var> coin. <syntaxhighlight lang="prolog"> balance( Left, Right, Counterfeit, Result ):- counterfeit( Counterfeit, Coin, Weight ), ( contains_coin( Left, Coin ) -> balance_result( Weight, normal, Result ) ; contains_coin( Right, Coin ) -> balance_result( normal, Weight, Result ) ; otherwise -> Result = '=' ). balance_result( light, normal, < ). balance_result( heavy, normal, > ). balance_result( normal, heavy, < ). balance_result( normal, light, > ). </syntaxhighlight> ===Choosing which coins to weigh=== ====valid_partition( +Coins, ?Content, ?Left, ?Right, ?Table )==== holds when <var>Coins</var> can be partitioned into three collections: <var>Left</var> side, <var>Right</var> side and <var>Table</var>; with the 'information content' of the partition given by <var>Content</var>. The definition of a 'valid partition' ensures that: * <var>Left</var> and <var>Right</var> must have the same number of coins (at least one); * <var>Left</var> cannot contain any known 'true' coins, because adding true coins to both sides creates redundant comparisons. A 'checksum' is used to ensure that only one member of each pair of symmetrical solutions can be generated. <syntaxhighlight lang="prolog"> valid_partition( Coins, Content, Left, Right, Table ):- part( known_true, Left, [] ), selection( Coins, Left, Coins1, Count, LeftChecksum, LeftInfo ), Count >= 1, selection( Coins1, Right, Table, Count, RightChecksum, RightInfo ), LeftChecksum =< RightChecksum, % Checksum to prevent symmetrical solutions table_information( Table, TableInfo ), sum( [LeftInfo,RightInfo,TableInfo], Content ). </syntaxhighlight> ====selection( +Coins, ?Sample, ?Residue, ?Count, ?Checksum, ?Content )==== holds when <var>Coins</var> is partitioned into two collections: <var>Sample</var> and <var>Residue</var>. <var>Count</var> is the number of coins in <var>Sample</var>. <var>Checksum</var> is a fingerprint for the mixture of coins in <var>Sample</var>, which has 'information content' <var>Content</var>. <syntaxhighlight lang="prolog"> selection( Coins, Sample, Residue, Count, Checksum, Content ) :- select_coins( not_heavy, Coins, Sample, Residue, Count1 ), select_coins( not_light, Coins, Sample, Residue, Count2 ), select_coins( untested, Coins, Sample, Residue, Count3 ), select_coins( known_true, Coins, Sample, Residue, Count4 ), Count is Count1+Count2+Count3+Count4, Count =< 6, Checksum is Count1+(7*Count2)+(43*Count3)+(259*Count4), information_content( [Count1,Count2,Count3,Count4], Content ). table_information( Coins, Content ) :- count_coins( not_heavy, Coins, Count1 ), count_coins( not_light, Coins, Count2 ), count_coins( untested, Coins, Count3 ), count_coins( known_true, Coins, Count4 ), information_content( [Count1,Count2,Count3,Count4], Content ). count_coins( Part, Coins, Count ) :- part( Part, Coins, Selection ), length( Selection, Count ). </syntaxhighlight> === Updating what is known about the coins === ====draw_inferences( +Result, +Left, +Right, +Table, ?Coins )==== holds when <var>Result</var> is one of: * > (imbalance - left pan heavier), * < (imbalance - right pan heavier) or * <nowiki>=</nowiki> (pans balanced) from taking a weighing with the coin collections: <var>Left</var>, <var> Right</var> and <var>Table</var>. <var>Coins</var> is derived from this information using the following rules: * If the pans are unbalanced then only the previously untested or not_heavy coins on the lighter side of the balance are now not_heavy. Similarly, only the previously untested or not_light coins on the heavier side of the balance are now not_light. All the coins on the table are now known_true. * If the pans balance then all the coins weighed are known_true, with the coins on the <var>Table</var> left in their prior states. <syntaxhighlight lang="prolog"> draw_inferences( <, Left, Right, Table, Coins ) :- imbalance_inferences( Left, Right, Table, Coins ). draw_inferences( >, Left, Right, Table, Coins ) :- imbalance_inferences( Right, Left, Table, Coins ). draw_inferences( =, Left, Right, Table, Coins ) :- inference( [all(Left),known_true(Table),all(Right)], known_true( Coins ) ), inference( untested(Table), untested(Coins) ), inference( not_heavy(Table), not_heavy(Coins) ), inference( not_light(Table), not_light(Coins) ). </syntaxhighlight> ====imbalance_inferences( +Lighter, +Heavier, +Table, ?Coins )==== holds when: * All untested or not_heavy coins in <var>Lighter</var> are not_heavy in <var>Coins </var>; * All untested or not_light coins in <var>Heavier</var> are not_light in <var>Coins </var>; * All coins in <var>Table</var> are known_true in <var>Coins</var>; There are no untested coins in <var>Coins</var>. <syntaxhighlight lang="prolog"> imbalance_inferences( Lighter, Heavier, Table, Coins ) :- inference( [untested(Lighter),not_heavy(Lighter)], not_heavy(Coins) ), inference( [untested(Heavier),not_light(Heavier)], not_light(Coins) ), inference( [ known_true(Lighter), not_light(Lighter), known_true(Heavier), not_heavy(Heavier), all(Table) ], known_true(Coins) ), part( untested, Coins, [] ). </syntaxhighlight> ====inference( +CollectionA, ?CollectionB )==== holds when (part) <var>CollectionB</var> comprises the same coins as (part) <var>CollectionA</var>. <syntaxhighlight lang="prolog"> inference( CollectionA, CollectionB ) :- unfolded( CollectionA, Coins ), unfolded( CollectionB, Coins ). </syntaxhighlight> ====unfolded( +Collection, ?Coins )==== holds when (part) <var>Collection</var> comprises <var>Coins</var>. <syntaxhighlight lang="prolog"> unfolded( not_light(Collection), Coins ) :- part( not_light, Collection, Coins ). unfolded( not_heavy(Collection), Coins ) :- part( not_heavy, Collection, Coins ). unfolded( known_true(Collection), Coins ) :- part( known_true, Collection, Coins ). unfolded( untested(Collection), Coins ) :- part( untested, Collection, Coins ). unfolded( all(Collection), Coins ) :- collection_to_set( Collection, Coins ). unfolded( [Item|Items], Coins ) :- unfolded( Item, Value ), unfolded1( Items, Value, Coins ). unfolded1( [], Coins, Coins ). unfolded1( [Item|Items], Value, Coins ) :- unfolded( Item, Value0 ), ord_union( Value0, Value, Value1 ), unfolded1( Items, Value1, Coins ). </syntaxhighlight> ==Definite Clause Grammar== The following DCG represents the method for finding the counterfeit coin as a 'structured' procedure. <syntaxhighlight lang="prolog"> general_explanation( Procedure ) --> "Number the coins 1..12", newline, explanation( Procedure, 0 ). explanation( done(Coin, Weight), N ) --> tab( N ), "Conclude that the counterfeit coin is number ", literal( Coin ), ", which is ", literal( Weight ), newline. explanation( Step, N ) --> {step( Step, Left, Right, Table, Branches )}, tab( N ), "BEGIN", newline, tab( N ), "Put ", literal( Left ), " on the left-hand pan", newline, tab( N ), "Put ", literal( Right ), " on the right-hand pan", newline, tab( N ), "Leaving ", literal( Table ), " on the table", newline, branches_explained( Branches, N ), tab( N ), "END", newline. branches_explained( Branches, N ) --> next_step_explained( <, Branches, N ), next_step_explained( >, Branches, N ), next_step_explained( =, Branches, N ). next_step_explained( Result, Branch, N ) --> {branch( Result, Branch, Step )}, ( {var(Step)} -> "" | {nonvar(Step)} -> tab( N ), "If the ", literal( Result ), " then:", newline, explanation( Step, s(N) ) ). literal( 0 ) --> "0". literal( 1 ) --> "1". literal( 2 ) --> "2". literal( 3 ) --> "3". literal( 4 ) --> "4". literal( 5 ) --> "5". literal( 6 ) --> "6". literal( 7 ) --> "7". literal( 8 ) --> "8". literal( 9 ) --> "9". literal( 10 ) --> "10". literal( 11 ) --> "11". literal( 12 ) --> "12". literal( true ) --> "true". literal( heavy ) --> "heavy". literal( light ) --> "light". literal( = ) --> "pans balance". literal( < ) --> "right-hand pan is heavier". literal( > ) --> "left-hand pan is heavier". literal( Collection ) --> {collection_to_set( Collection , [H|T] )}, literal_set( T, H ). literal_set( [], Number ) --> "the coin numbered ", literal( Number ). literal_set( [H|T], Number ) --> "the coins numbered ", literal( Number ), literal_set1( T, H ). literal_set1( [], Number ) --> " and ", literal( Number ). literal_set1( [H|T], Number ) --> ", ", literal( Number ), literal_set1( T, H ). tab( 0 ) --> "". tab( s(N) ) --> " ", tab( N ). newline --> " ". </syntaxhighlight> ===Utility Predicates=== ====contains_coin( ?Collection, ?Coin )==== holds when <var>Coin</var> is a member of <var>Collection</var>. <syntaxhighlight lang="prolog"> contains_coin( Collection, Coin ) :- part( _Part, Collection, Coins ), member( Coin, Coins ). </syntaxhighlight> ====collection_to_set( +Collection, ?Set )==== holds when <var>Set</var> is the distributed union of the <code>known_true</code>, <code>not_heavy</code>, <code>not_light</code> and <code>untested</code> ordsets comprising <var>Collection</var>. <syntaxhighlight lang="prolog"> collection_to_set( Collection, Set ) :- part( known_true, Collection, KnownTrue ), part( not_heavy, Collection, NotHeavy ), part( not_light, Collection, NotLight ), part( untested, Collection, Untested ), ord_union( [KnownTrue,NotHeavy,NotLight,Untested], Set ). </syntaxhighlight> ==== information_content( +Counts, ?Content ) ==== holds when <var>Content</var> is the cumulative negative entropy of <var>Counts</var>. A reduction in entropy equates to a gain in information. <syntaxhighlight lang="prolog"> information_content( Counts, Content ) :- information_content1( Counts, 0, Content ). information_content1( [], Content, Content ). information_content1( [Count|Counts], Content0, Content ):- coins_entropy( Count, Entropy ), Content1 is Content0-Entropy, information_content1( Counts, Content1, Content ). </syntaxhighlight> ==== coins_entropy( ?N, ?Entropy ) ==== holds when <var>Entropy</var> estimates the entropy of a sample of <var>N</var> coins. <var>Entropy</var> = P log₂1/P, where P = <var>N</var>/12. <syntaxhighlight lang="prolog"> coins_entropy( 0, 0.0 ). coins_entropy( 1, 0.2987 ). coins_entropy( 2, 0.4308 ). coins_entropy( 3, 0.5 ). coins_entropy( 4, 0.5283 ). coins_entropy( 5, 0.5263 ). coins_entropy( 6, 0.5 ). coins_entropy( 7, 0.4536 ). coins_entropy( 8, 0.39 ). coins_entropy( 9, 0.3113 ). coins_entropy( 10, 0.2192 ). coins_entropy( 11, 0.1151 ). coins_entropy( 12, 0.0 ). </syntaxhighlight> ====select_coins( +Part, +Count, ?Sample, ?Residue, ?Coins )==== <syntaxhighlight lang="prolog"> select_coins( Part, Coins, Sample, Residue, Count ) :- part( Part, Coins, Input ), part( Part, Sample, Selection ), part( Part, Residue, Remainder ), select_n( Count, Input, Selection, Remainder ). select_n( 0, In, [], In ). select_n( 1, [A|Suffix], [A], Suffix ). select_n( 2, [A,B|Suffix], [A,B], Suffix ). select_n( 3, [A,B,C|Suffix], [A,B,C], Suffix ). select_n( 4, [A,B,C,D|Suffix], [A,B,C,D], Suffix ). select_n( 5, [A,B,C,D,E|Suffix], [A,B,C,D,E], Suffix ). select_n( 6, [A,B,C,D,E,F|Suffix], [A,B,C,D,E,F], Suffix ). </syntaxhighlight> Load a small library of [puzzle utilities.] <syntaxhighlight lang="prolog"> :- ensure_loaded( misc ). </syntaxhighlight> Use the ordsets library. <syntaxhighlight lang="prolog"> :- use_module( library(ordsets), [ord_union/2,ord_union/3] ). </syntaxhighlight> ==Output== <div class="result"> Number the coins 1..12 BEGIN Put the coins numbered 1, 2, 3 and 4 on the left-hand pan Put the coins numbered 5, 6, 7 and 8 on the right-hand pan Leaving the coins numbered 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 1, 2, 5 and 6 on the left-hand pan Put the coins numbered 3, 7, 9 and 10 on the right-hand pan Leaving the coins numbered 4, 8, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 1 and 7 on the left-hand pan Put the coins numbered 3 and 4 on the right-hand pan Leaving the coins numbered 2, 5, 6, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 1, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 7, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 2, which is light END If the left-hand pan is heavier then: BEGIN Put the coins numbered 3 and 5 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 4, 6, 7, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 3, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 5, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 6, which is heavy END If the pans balance then: BEGIN Put the coins numbered 4 and 8 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 3, 5, 6, 7, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 4, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 8, which is heavy END END If the left-hand pan is heavier then: BEGIN Put the coins numbered 1, 2, 5 and 6 on the left-hand pan Put the coins numbered 3, 7, 9 and 10 on the right-hand pan Leaving the coins numbered 4, 8, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 3 and 5 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 4, 6, 7, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 5, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 3, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 6, which is light END If the left-hand pan is heavier then: BEGIN Put the coins numbered 1 and 7 on the left-hand pan Put the coins numbered 3 and 4 on the right-hand pan Leaving the coins numbered 2, 5, 6, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 7, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 1, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 2, which is heavy END If the pans balance then: BEGIN Put the coins numbered 4 and 8 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 3, 5, 6, 7, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 8, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 4, which is heavy END END If the pans balance then: BEGIN Put the coins numbered 9, 10 and 11 on the left-hand pan Put the coins numbered 1, 2 and 3 on the right-hand pan Leaving the coins numbered 4, 5, 6, 7, 8 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coin numbered 9 on the left-hand pan Put the coin numbered 10 on the right-hand pan Leaving the coins numbered 1, 2, 3, 4, 5, 6, 7, 8, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 9, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 10, which is light If the pans balance then: Conclude that the counterfeit coin is number 11, which is light END If the left-hand pan is heavier then: BEGIN Put the coin numbered 9 on the left-hand pan Put the coin numbered 10 on the right-hand pan Leaving the coins numbered 1, 2, 3, 4, 5, 6, 7, 8, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 10, which is heavy If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 9, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 11, which is heavy END If the pans balance then: BEGIN Put the coin numbered 12 on the left-hand pan Put the coin numbered 1 on the right-hand pan Leaving the coins numbered 2, 3, 4, 5, 6, 7, 8, 9, 10 and 11 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 12, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 12, which is heavy END END END </div> ---- 0cf73f8bb76c64e86072e1bed874d66f7226714d 13 12 2013-06-21T22:33:57Z John 2 /* assay( +Counterfeit, +Coins0, ?Step, ?Branch, ?Coins1 ) */ wikitext text/x-wiki __NOTOC__ ==Problem Definition== We are given 12 apparently identical coins - one of which is counterfeit. We know that the counterfeit has a different weight from the others, but we don't know if it's heavier or lighter. ===Task:=== Devise a procedure to identify any counterfeit coin using a balance to take up to three comparative weighings. ==Strategy== The information from three suitable weighings will make all but one of the 'coins', which are untested initially, 'known true'. There are three alternative deductions that make a coin 'known true': * if it is 'not heavy' and 'not light' - having been on both the comparatively lighter and heavier sides of imbalances; * if it was excluded from an imbalance; * if it was included in a balanced weighing. After three weighings there must be exactly one coin, the counterfeit, which is not 'true'. If the counterfeit is not true and 'not heavy' we deduce that it must be light. If it is not true and 'not light', it must be heavy. We use a 'generate-and-test' method as follows: * Create the set of all possible 'counterfeits': 12 coins &times; 2 weights ; * Devise a procedure that can identify the first counterfeit coin; * Show that the same procedure works for every other counterfeit. ==Entry Point== ====go==== is the entry point. It solves the puzzle, then uses a DCG to pretty-print the resulting procedure. <syntaxhighlight lang="prolog"> go :- coins_puzzle( Procedure ), phrase( general_explanation( Procedure ), Chars ), put_chars( Chars ). </syntaxhighlight> ====coins_puzzle( ?Procedure )==== generates the set of all possible 'counterfeits' and finds (or proves) that <var>Procedure</var> can identify them all. <syntaxhighlight lang="prolog"> coins_puzzle( Procedure ) :- coins( Coins ), counterfeit( Counterfeit, Coin, Weight ), findall( Counterfeit, (member(Coin,Coins), counterfeit_weight(Weight)), Counterfeits ), coins_puzzle_solution( Counterfeits, Procedure ). coins_puzzle_solution( [], _Procedure ). coins_puzzle_solution( [Counterfeit|Counterfeits], Procedure ) :- solve_coins( Counterfeit, Procedure ), coins_puzzle_solution( Counterfeits, Procedure ). </syntaxhighlight> A procedure is either 'done', identifying a particular coin and whether it is 'heavy' or 'light'; or it is a 'step'. A step defines the coins to be placed on the <var>Left</var> and <var>Right</var> pans, with the residue remaining on the <var>Table</var>, and three <var>Branches</var>, one of which will be chosen depending on the outcome of the weighing. <syntaxhighlight lang="prolog"> step( step(Left,Right,Table,Branches), Left, Right, Table, Branches). </syntaxhighlight> The <var>Branches</var> are three procedures equating to: * > (left pan heavier), * < (right pan heavier) and * <nowiki>= (pans balance).</nowiki> <syntaxhighlight lang="prolog"> branch( >, branches(_Equal, GT, _LT), GT ). branch( <, branches(_Equal, _GT, LT), LT ). branch( =, branches(Equal, _GT, _LT), Equal ). </syntaxhighlight> The counterfeit is defined by its number and whether it is heavy or light. <syntaxhighlight lang="prolog"> counterfeit( counterfeit(Coin, HeavyOrLight), Coin, HeavyOrLight ). coins( [1,2,3,4,5,6,7,8,9,10,11,12] ). counterfeit_weight( heavy ). counterfeit_weight( light ). </syntaxhighlight> A 'coin collection' comprises four 'parts' (subsets): the <code>known_true</code>, <code>not_heavy</code>, <code>not_light</code> and <code>untested</code> sets of coins. <syntaxhighlight lang="prolog"> part( known_true, collection(Coins,_,_,_), Coins ). part( not_heavy, collection(_,Coins,_,_), Coins ). part( not_light, collection(_,_,Coins,_), Coins ). part( untested, collection(_,_,_,Coins), Coins ). </syntaxhighlight> ==Solution== ====solve_coins( +Counterfeit, ?Procedure )==== holds when <var> Procedure</var> can correctly identify the <var>Counterfeit</var> coin. Beginning with a 'start' collection, in which all the coins are untested, the <var>Procedure</var> comprises three 'steps'. For each step a 'weighing' is made and a 'branch' is made in the <var>Procedure</var>, depending on the result of the weighing. After three steps, the <var>Procedure</var> must have reached the 'end' condition. Finally, an assertion (redundant test) ensures that the <var> Procedure</var> has found the correct end condition. <syntaxhighlight lang="prolog"> solve_coins( Counterfeit, Procedure ) :- start( Coins0 ), assay( Counterfeit, Coins0, Procedure, Branch1, Coins1 ), assay( Counterfeit, Coins1, Branch1, Branch2, Coins2 ), assay( Counterfeit, Coins2, Branch2, done(Coin, HeavyOrLight), Coins3 ), end( Coins3, Coin, HeavyOrLight ), counterfeit( Counterfeit, Coin, HeavyOrLight ). start( Coins ) :- coins( Untested ), part( untested, Coins, Untested ), part( not_heavy, Coins, [] ), part( not_light, Coins, [] ), part( known_true, Coins, [] ). end( Coins, Coin, HeavyOrLight ) :- part( untested, Coins, [] ), part( not_heavy, Coins, Light ), part( not_light, Coins, Heavy ), end_result( Heavy, Light, Coin, HeavyOrLight ). end_result( [Coin], [], Coin, heavy ). end_result( [], [Coin], Coin, light ). </syntaxhighlight> === Simulating the weighing process === ====assay( +Counterfeit, +Coins0, ?Step, ?Branch, ?Coins1 )==== holds when the appropriate <var>Branch</var> from <var>Step</var> is chosen by comparing the weights of two coin collections taken from the full set of coins: <var>Coins0</var>. <var>Coins1</var> is the full set of coins, updated with the inferences drawn from the weighing. <var>Counterfeit</var> is used to determine the result of the weighing. This predicate applies the critical insight into the solution of this puzzle: we have 24 (12 &times; 2) possible inputs to the procedure, with only 27 (3 &times; 3 &times; 3) possible outcomes from the weighings. Therefore, it is clear that each weighing must have a very high 'information content'. Choosing a weighing by information content makes the problem tractable. <syntaxhighlight lang="prolog"> assay( Counterfeit, Coins0, Step, Branch, Coins ) :- WeighingDatum = weighing_data(InfoContent, Left, Right, Table), step( Step, Left, Right, Table, Branches ), findall( WeighingDatum, valid_partition( Coins0, InfoContent, Left, Right, Table ), WeighingData ), sort( WeighingData, OrderedWeighingData ), member( WeighingDatum, OrderedWeighingData ), balance( Left, Right, Counterfeit, Result ), draw_inferences( Result, Left, Right, Table, Coins ), branch( Result, Branches, Branch ). </syntaxhighlight> ====balance( +Left, +Right, +Counterfeit, ? Result )==== holds when <var>Result</var> simulates the outcome of testing the coin collections <var>Left</var> and <var>Right</var> with a balance, where either may contain the <var>Counterfeit</var> coin. <syntaxhighlight lang="prolog"> balance( Left, Right, Counterfeit, Result ):- counterfeit( Counterfeit, Coin, Weight ), ( contains_coin( Left, Coin ) -> balance_result( Weight, normal, Result ) ; contains_coin( Right, Coin ) -> balance_result( normal, Weight, Result ) ; otherwise -> Result = '=' ). balance_result( light, normal, < ). balance_result( heavy, normal, > ). balance_result( normal, heavy, < ). balance_result( normal, light, > ). </syntaxhighlight> ===Choosing which coins to weigh=== ====valid_partition( +Coins, ?Content, ?Left, ?Right, ?Table )==== holds when <var>Coins</var> can be partitioned into three collections: <var>Left</var> side, <var>Right</var> side and <var>Table</var>; with the 'information content' of the partition given by <var>Content</var>. The definition of a 'valid partition' ensures that: * <var>Left</var> and <var>Right</var> must have the same number of coins (at least one); * <var>Left</var> cannot contain any known 'true' coins, because adding true coins to both sides creates redundant comparisons. A 'checksum' is used to ensure that only one member of each pair of symmetrical solutions can be generated. <syntaxhighlight lang="prolog"> valid_partition( Coins, Content, Left, Right, Table ):- part( known_true, Left, [] ), selection( Coins, Left, Coins1, Count, LeftChecksum, LeftInfo ), Count >= 1, selection( Coins1, Right, Table, Count, RightChecksum, RightInfo ), LeftChecksum =< RightChecksum, % Checksum to prevent symmetrical solutions table_information( Table, TableInfo ), sum( [LeftInfo,RightInfo,TableInfo], Content ). </syntaxhighlight> ====selection( +Coins, ?Sample, ?Residue, ?Count, ?Checksum, ?Content )==== holds when <var>Coins</var> is partitioned into two collections: <var>Sample</var> and <var>Residue</var>. <var>Count</var> is the number of coins in <var>Sample</var>. <var>Checksum</var> is a fingerprint for the mixture of coins in <var>Sample</var>, which has 'information content' <var>Content</var>. <syntaxhighlight lang="prolog"> selection( Coins, Sample, Residue, Count, Checksum, Content ) :- select_coins( not_heavy, Coins, Sample, Residue, Count1 ), select_coins( not_light, Coins, Sample, Residue, Count2 ), select_coins( untested, Coins, Sample, Residue, Count3 ), select_coins( known_true, Coins, Sample, Residue, Count4 ), Count is Count1+Count2+Count3+Count4, Count =< 6, Checksum is Count1+(7*Count2)+(43*Count3)+(259*Count4), information_content( [Count1,Count2,Count3,Count4], Content ). table_information( Coins, Content ) :- count_coins( not_heavy, Coins, Count1 ), count_coins( not_light, Coins, Count2 ), count_coins( untested, Coins, Count3 ), count_coins( known_true, Coins, Count4 ), information_content( [Count1,Count2,Count3,Count4], Content ). count_coins( Part, Coins, Count ) :- part( Part, Coins, Selection ), length( Selection, Count ). </syntaxhighlight> === Updating what is known about the coins === ====draw_inferences( +Result, +Left, +Right, +Table, ?Coins )==== holds when <var>Result</var> is one of: * > (imbalance - left pan heavier), * < (imbalance - right pan heavier) or * <nowiki>=</nowiki> (pans balanced) from taking a weighing with the coin collections: <var>Left</var>, <var> Right</var> and <var>Table</var>. <var>Coins</var> is derived from this information using the following rules: * If the pans are unbalanced then only the previously untested or not_heavy coins on the lighter side of the balance are now not_heavy. Similarly, only the previously untested or not_light coins on the heavier side of the balance are now not_light. All the coins on the table are now known_true. * If the pans balance then all the coins weighed are known_true, with the coins on the <var>Table</var> left in their prior states. <syntaxhighlight lang="prolog"> draw_inferences( <, Left, Right, Table, Coins ) :- imbalance_inferences( Left, Right, Table, Coins ). draw_inferences( >, Left, Right, Table, Coins ) :- imbalance_inferences( Right, Left, Table, Coins ). draw_inferences( =, Left, Right, Table, Coins ) :- inference( [all(Left),known_true(Table),all(Right)], known_true( Coins ) ), inference( untested(Table), untested(Coins) ), inference( not_heavy(Table), not_heavy(Coins) ), inference( not_light(Table), not_light(Coins) ). </syntaxhighlight> ====imbalance_inferences( +Lighter, +Heavier, +Table, ?Coins )==== holds when: * All untested or not_heavy coins in <var>Lighter</var> are not_heavy in <var>Coins </var>; * All untested or not_light coins in <var>Heavier</var> are not_light in <var>Coins </var>; * All coins in <var>Table</var> are known_true in <var>Coins</var>; There are no untested coins in <var>Coins</var>. <syntaxhighlight lang="prolog"> imbalance_inferences( Lighter, Heavier, Table, Coins ) :- inference( [untested(Lighter),not_heavy(Lighter)], not_heavy(Coins) ), inference( [untested(Heavier),not_light(Heavier)], not_light(Coins) ), inference( [ known_true(Lighter), not_light(Lighter), known_true(Heavier), not_heavy(Heavier), all(Table) ], known_true(Coins) ), part( untested, Coins, [] ). </syntaxhighlight> ====inference( +CollectionA, ?CollectionB )==== holds when (part) <var>CollectionB</var> comprises the same coins as (part) <var>CollectionA</var>. <syntaxhighlight lang="prolog"> inference( CollectionA, CollectionB ) :- unfolded( CollectionA, Coins ), unfolded( CollectionB, Coins ). </syntaxhighlight> ====unfolded( +Collection, ?Coins )==== holds when (part) <var>Collection</var> comprises <var>Coins</var>. <syntaxhighlight lang="prolog"> unfolded( not_light(Collection), Coins ) :- part( not_light, Collection, Coins ). unfolded( not_heavy(Collection), Coins ) :- part( not_heavy, Collection, Coins ). unfolded( known_true(Collection), Coins ) :- part( known_true, Collection, Coins ). unfolded( untested(Collection), Coins ) :- part( untested, Collection, Coins ). unfolded( all(Collection), Coins ) :- collection_to_set( Collection, Coins ). unfolded( [Item|Items], Coins ) :- unfolded( Item, Value ), unfolded1( Items, Value, Coins ). unfolded1( [], Coins, Coins ). unfolded1( [Item|Items], Value, Coins ) :- unfolded( Item, Value0 ), ord_union( Value0, Value, Value1 ), unfolded1( Items, Value1, Coins ). </syntaxhighlight> ==Definite Clause Grammar== The following DCG represents the method for finding the counterfeit coin as a 'structured' procedure. <syntaxhighlight lang="prolog"> general_explanation( Procedure ) --> "Number the coins 1..12", newline, explanation( Procedure, 0 ). explanation( done(Coin, Weight), N ) --> tab( N ), "Conclude that the counterfeit coin is number ", literal( Coin ), ", which is ", literal( Weight ), newline. explanation( Step, N ) --> {step( Step, Left, Right, Table, Branches )}, tab( N ), "BEGIN", newline, tab( N ), "Put ", literal( Left ), " on the left-hand pan", newline, tab( N ), "Put ", literal( Right ), " on the right-hand pan", newline, tab( N ), "Leaving ", literal( Table ), " on the table", newline, branches_explained( Branches, N ), tab( N ), "END", newline. branches_explained( Branches, N ) --> next_step_explained( <, Branches, N ), next_step_explained( >, Branches, N ), next_step_explained( =, Branches, N ). next_step_explained( Result, Branch, N ) --> {branch( Result, Branch, Step )}, ( {var(Step)} -> "" | {nonvar(Step)} -> tab( N ), "If the ", literal( Result ), " then:", newline, explanation( Step, s(N) ) ). literal( 0 ) --> "0". literal( 1 ) --> "1". literal( 2 ) --> "2". literal( 3 ) --> "3". literal( 4 ) --> "4". literal( 5 ) --> "5". literal( 6 ) --> "6". literal( 7 ) --> "7". literal( 8 ) --> "8". literal( 9 ) --> "9". literal( 10 ) --> "10". literal( 11 ) --> "11". literal( 12 ) --> "12". literal( true ) --> "true". literal( heavy ) --> "heavy". literal( light ) --> "light". literal( = ) --> "pans balance". literal( < ) --> "right-hand pan is heavier". literal( > ) --> "left-hand pan is heavier". literal( Collection ) --> {collection_to_set( Collection , [H|T] )}, literal_set( T, H ). literal_set( [], Number ) --> "the coin numbered ", literal( Number ). literal_set( [H|T], Number ) --> "the coins numbered ", literal( Number ), literal_set1( T, H ). literal_set1( [], Number ) --> " and ", literal( Number ). literal_set1( [H|T], Number ) --> ", ", literal( Number ), literal_set1( T, H ). tab( 0 ) --> "". tab( s(N) ) --> " ", tab( N ). newline --> " ". </syntaxhighlight> ===Utility Predicates=== ====contains_coin( ?Collection, ?Coin )==== holds when <var>Coin</var> is a member of <var>Collection</var>. <syntaxhighlight lang="prolog"> contains_coin( Collection, Coin ) :- part( _Part, Collection, Coins ), member( Coin, Coins ). </syntaxhighlight> ====collection_to_set( +Collection, ?Set )==== holds when <var>Set</var> is the distributed union of the <code>known_true</code>, <code>not_heavy</code>, <code>not_light</code> and <code>untested</code> ordsets comprising <var>Collection</var>. <syntaxhighlight lang="prolog"> collection_to_set( Collection, Set ) :- part( known_true, Collection, KnownTrue ), part( not_heavy, Collection, NotHeavy ), part( not_light, Collection, NotLight ), part( untested, Collection, Untested ), ord_union( [KnownTrue,NotHeavy,NotLight,Untested], Set ). </syntaxhighlight> ==== information_content( +Counts, ?Content ) ==== holds when <var>Content</var> is the cumulative negative entropy of <var>Counts</var>. A reduction in entropy equates to a gain in information. <syntaxhighlight lang="prolog"> information_content( Counts, Content ) :- information_content1( Counts, 0, Content ). information_content1( [], Content, Content ). information_content1( [Count|Counts], Content0, Content ):- coins_entropy( Count, Entropy ), Content1 is Content0-Entropy, information_content1( Counts, Content1, Content ). </syntaxhighlight> ==== coins_entropy( ?N, ?Entropy ) ==== holds when <var>Entropy</var> estimates the entropy of a sample of <var>N</var> coins. <var>Entropy</var> = P log₂1/P, where P = <var>N</var>/12. <syntaxhighlight lang="prolog"> coins_entropy( 0, 0.0 ). coins_entropy( 1, 0.2987 ). coins_entropy( 2, 0.4308 ). coins_entropy( 3, 0.5 ). coins_entropy( 4, 0.5283 ). coins_entropy( 5, 0.5263 ). coins_entropy( 6, 0.5 ). coins_entropy( 7, 0.4536 ). coins_entropy( 8, 0.39 ). coins_entropy( 9, 0.3113 ). coins_entropy( 10, 0.2192 ). coins_entropy( 11, 0.1151 ). coins_entropy( 12, 0.0 ). </syntaxhighlight> ====select_coins( +Part, +Count, ?Sample, ?Residue, ?Coins )==== <syntaxhighlight lang="prolog"> select_coins( Part, Coins, Sample, Residue, Count ) :- part( Part, Coins, Input ), part( Part, Sample, Selection ), part( Part, Residue, Remainder ), select_n( Count, Input, Selection, Remainder ). select_n( 0, In, [], In ). select_n( 1, [A|Suffix], [A], Suffix ). select_n( 2, [A,B|Suffix], [A,B], Suffix ). select_n( 3, [A,B,C|Suffix], [A,B,C], Suffix ). select_n( 4, [A,B,C,D|Suffix], [A,B,C,D], Suffix ). select_n( 5, [A,B,C,D,E|Suffix], [A,B,C,D,E], Suffix ). select_n( 6, [A,B,C,D,E,F|Suffix], [A,B,C,D,E,F], Suffix ). </syntaxhighlight> Load a small library of [puzzle utilities.] <syntaxhighlight lang="prolog"> :- ensure_loaded( misc ). </syntaxhighlight> Use the ordsets library. <syntaxhighlight lang="prolog"> :- use_module( library(ordsets), [ord_union/2,ord_union/3] ). </syntaxhighlight> ==Output== <div class="result"> Number the coins 1..12 BEGIN Put the coins numbered 1, 2, 3 and 4 on the left-hand pan Put the coins numbered 5, 6, 7 and 8 on the right-hand pan Leaving the coins numbered 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 1, 2, 5 and 6 on the left-hand pan Put the coins numbered 3, 7, 9 and 10 on the right-hand pan Leaving the coins numbered 4, 8, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 1 and 7 on the left-hand pan Put the coins numbered 3 and 4 on the right-hand pan Leaving the coins numbered 2, 5, 6, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 1, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 7, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 2, which is light END If the left-hand pan is heavier then: BEGIN Put the coins numbered 3 and 5 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 4, 6, 7, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 3, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 5, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 6, which is heavy END If the pans balance then: BEGIN Put the coins numbered 4 and 8 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 3, 5, 6, 7, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 4, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 8, which is heavy END END If the left-hand pan is heavier then: BEGIN Put the coins numbered 1, 2, 5 and 6 on the left-hand pan Put the coins numbered 3, 7, 9 and 10 on the right-hand pan Leaving the coins numbered 4, 8, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 3 and 5 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 4, 6, 7, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 5, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 3, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 6, which is light END If the left-hand pan is heavier then: BEGIN Put the coins numbered 1 and 7 on the left-hand pan Put the coins numbered 3 and 4 on the right-hand pan Leaving the coins numbered 2, 5, 6, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 7, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 1, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 2, which is heavy END If the pans balance then: BEGIN Put the coins numbered 4 and 8 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 3, 5, 6, 7, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 8, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 4, which is heavy END END If the pans balance then: BEGIN Put the coins numbered 9, 10 and 11 on the left-hand pan Put the coins numbered 1, 2 and 3 on the right-hand pan Leaving the coins numbered 4, 5, 6, 7, 8 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coin numbered 9 on the left-hand pan Put the coin numbered 10 on the right-hand pan Leaving the coins numbered 1, 2, 3, 4, 5, 6, 7, 8, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 9, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 10, which is light If the pans balance then: Conclude that the counterfeit coin is number 11, which is light END If the left-hand pan is heavier then: BEGIN Put the coin numbered 9 on the left-hand pan Put the coin numbered 10 on the right-hand pan Leaving the coins numbered 1, 2, 3, 4, 5, 6, 7, 8, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 10, which is heavy If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 9, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 11, which is heavy END If the pans balance then: BEGIN Put the coin numbered 12 on the left-hand pan Put the coin numbered 1 on the right-hand pan Leaving the coins numbered 2, 3, 4, 5, 6, 7, 8, 9, 10 and 11 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 12, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 12, which is heavy END END END </div> ---- cab602ae223f2130a5244ee137f5d9d2c95ff637 14 13 2013-06-21T22:37:47Z John 2 /* coins_entropy( ?N, ?Entropy ) */ wikitext text/x-wiki __NOTOC__ ==Problem Definition== We are given 12 apparently identical coins - one of which is counterfeit. We know that the counterfeit has a different weight from the others, but we don't know if it's heavier or lighter. ===Task:=== Devise a procedure to identify any counterfeit coin using a balance to take up to three comparative weighings. ==Strategy== The information from three suitable weighings will make all but one of the 'coins', which are untested initially, 'known true'. There are three alternative deductions that make a coin 'known true': * if it is 'not heavy' and 'not light' - having been on both the comparatively lighter and heavier sides of imbalances; * if it was excluded from an imbalance; * if it was included in a balanced weighing. After three weighings there must be exactly one coin, the counterfeit, which is not 'true'. If the counterfeit is not true and 'not heavy' we deduce that it must be light. If it is not true and 'not light', it must be heavy. We use a 'generate-and-test' method as follows: * Create the set of all possible 'counterfeits': 12 coins &times; 2 weights ; * Devise a procedure that can identify the first counterfeit coin; * Show that the same procedure works for every other counterfeit. ==Entry Point== ====go==== is the entry point. It solves the puzzle, then uses a DCG to pretty-print the resulting procedure. <syntaxhighlight lang="prolog"> go :- coins_puzzle( Procedure ), phrase( general_explanation( Procedure ), Chars ), put_chars( Chars ). </syntaxhighlight> ====coins_puzzle( ?Procedure )==== generates the set of all possible 'counterfeits' and finds (or proves) that <var>Procedure</var> can identify them all. <syntaxhighlight lang="prolog"> coins_puzzle( Procedure ) :- coins( Coins ), counterfeit( Counterfeit, Coin, Weight ), findall( Counterfeit, (member(Coin,Coins), counterfeit_weight(Weight)), Counterfeits ), coins_puzzle_solution( Counterfeits, Procedure ). coins_puzzle_solution( [], _Procedure ). coins_puzzle_solution( [Counterfeit|Counterfeits], Procedure ) :- solve_coins( Counterfeit, Procedure ), coins_puzzle_solution( Counterfeits, Procedure ). </syntaxhighlight> A procedure is either 'done', identifying a particular coin and whether it is 'heavy' or 'light'; or it is a 'step'. A step defines the coins to be placed on the <var>Left</var> and <var>Right</var> pans, with the residue remaining on the <var>Table</var>, and three <var>Branches</var>, one of which will be chosen depending on the outcome of the weighing. <syntaxhighlight lang="prolog"> step( step(Left,Right,Table,Branches), Left, Right, Table, Branches). </syntaxhighlight> The <var>Branches</var> are three procedures equating to: * > (left pan heavier), * < (right pan heavier) and * <nowiki>= (pans balance).</nowiki> <syntaxhighlight lang="prolog"> branch( >, branches(_Equal, GT, _LT), GT ). branch( <, branches(_Equal, _GT, LT), LT ). branch( =, branches(Equal, _GT, _LT), Equal ). </syntaxhighlight> The counterfeit is defined by its number and whether it is heavy or light. <syntaxhighlight lang="prolog"> counterfeit( counterfeit(Coin, HeavyOrLight), Coin, HeavyOrLight ). coins( [1,2,3,4,5,6,7,8,9,10,11,12] ). counterfeit_weight( heavy ). counterfeit_weight( light ). </syntaxhighlight> A 'coin collection' comprises four 'parts' (subsets): the <code>known_true</code>, <code>not_heavy</code>, <code>not_light</code> and <code>untested</code> sets of coins. <syntaxhighlight lang="prolog"> part( known_true, collection(Coins,_,_,_), Coins ). part( not_heavy, collection(_,Coins,_,_), Coins ). part( not_light, collection(_,_,Coins,_), Coins ). part( untested, collection(_,_,_,Coins), Coins ). </syntaxhighlight> ==Solution== ====solve_coins( +Counterfeit, ?Procedure )==== holds when <var> Procedure</var> can correctly identify the <var>Counterfeit</var> coin. Beginning with a 'start' collection, in which all the coins are untested, the <var>Procedure</var> comprises three 'steps'. For each step a 'weighing' is made and a 'branch' is made in the <var>Procedure</var>, depending on the result of the weighing. After three steps, the <var>Procedure</var> must have reached the 'end' condition. Finally, an assertion (redundant test) ensures that the <var> Procedure</var> has found the correct end condition. <syntaxhighlight lang="prolog"> solve_coins( Counterfeit, Procedure ) :- start( Coins0 ), assay( Counterfeit, Coins0, Procedure, Branch1, Coins1 ), assay( Counterfeit, Coins1, Branch1, Branch2, Coins2 ), assay( Counterfeit, Coins2, Branch2, done(Coin, HeavyOrLight), Coins3 ), end( Coins3, Coin, HeavyOrLight ), counterfeit( Counterfeit, Coin, HeavyOrLight ). start( Coins ) :- coins( Untested ), part( untested, Coins, Untested ), part( not_heavy, Coins, [] ), part( not_light, Coins, [] ), part( known_true, Coins, [] ). end( Coins, Coin, HeavyOrLight ) :- part( untested, Coins, [] ), part( not_heavy, Coins, Light ), part( not_light, Coins, Heavy ), end_result( Heavy, Light, Coin, HeavyOrLight ). end_result( [Coin], [], Coin, heavy ). end_result( [], [Coin], Coin, light ). </syntaxhighlight> === Simulating the weighing process === ====assay( +Counterfeit, +Coins0, ?Step, ?Branch, ?Coins1 )==== holds when the appropriate <var>Branch</var> from <var>Step</var> is chosen by comparing the weights of two coin collections taken from the full set of coins: <var>Coins0</var>. <var>Coins1</var> is the full set of coins, updated with the inferences drawn from the weighing. <var>Counterfeit</var> is used to determine the result of the weighing. This predicate applies the critical insight into the solution of this puzzle: we have 24 (12 &times; 2) possible inputs to the procedure, with only 27 (3 &times; 3 &times; 3) possible outcomes from the weighings. Therefore, it is clear that each weighing must have a very high 'information content'. Choosing a weighing by information content makes the problem tractable. <syntaxhighlight lang="prolog"> assay( Counterfeit, Coins0, Step, Branch, Coins ) :- WeighingDatum = weighing_data(InfoContent, Left, Right, Table), step( Step, Left, Right, Table, Branches ), findall( WeighingDatum, valid_partition( Coins0, InfoContent, Left, Right, Table ), WeighingData ), sort( WeighingData, OrderedWeighingData ), member( WeighingDatum, OrderedWeighingData ), balance( Left, Right, Counterfeit, Result ), draw_inferences( Result, Left, Right, Table, Coins ), branch( Result, Branches, Branch ). </syntaxhighlight> ====balance( +Left, +Right, +Counterfeit, ? Result )==== holds when <var>Result</var> simulates the outcome of testing the coin collections <var>Left</var> and <var>Right</var> with a balance, where either may contain the <var>Counterfeit</var> coin. <syntaxhighlight lang="prolog"> balance( Left, Right, Counterfeit, Result ):- counterfeit( Counterfeit, Coin, Weight ), ( contains_coin( Left, Coin ) -> balance_result( Weight, normal, Result ) ; contains_coin( Right, Coin ) -> balance_result( normal, Weight, Result ) ; otherwise -> Result = '=' ). balance_result( light, normal, < ). balance_result( heavy, normal, > ). balance_result( normal, heavy, < ). balance_result( normal, light, > ). </syntaxhighlight> ===Choosing which coins to weigh=== ====valid_partition( +Coins, ?Content, ?Left, ?Right, ?Table )==== holds when <var>Coins</var> can be partitioned into three collections: <var>Left</var> side, <var>Right</var> side and <var>Table</var>; with the 'information content' of the partition given by <var>Content</var>. The definition of a 'valid partition' ensures that: * <var>Left</var> and <var>Right</var> must have the same number of coins (at least one); * <var>Left</var> cannot contain any known 'true' coins, because adding true coins to both sides creates redundant comparisons. A 'checksum' is used to ensure that only one member of each pair of symmetrical solutions can be generated. <syntaxhighlight lang="prolog"> valid_partition( Coins, Content, Left, Right, Table ):- part( known_true, Left, [] ), selection( Coins, Left, Coins1, Count, LeftChecksum, LeftInfo ), Count >= 1, selection( Coins1, Right, Table, Count, RightChecksum, RightInfo ), LeftChecksum =< RightChecksum, % Checksum to prevent symmetrical solutions table_information( Table, TableInfo ), sum( [LeftInfo,RightInfo,TableInfo], Content ). </syntaxhighlight> ====selection( +Coins, ?Sample, ?Residue, ?Count, ?Checksum, ?Content )==== holds when <var>Coins</var> is partitioned into two collections: <var>Sample</var> and <var>Residue</var>. <var>Count</var> is the number of coins in <var>Sample</var>. <var>Checksum</var> is a fingerprint for the mixture of coins in <var>Sample</var>, which has 'information content' <var>Content</var>. <syntaxhighlight lang="prolog"> selection( Coins, Sample, Residue, Count, Checksum, Content ) :- select_coins( not_heavy, Coins, Sample, Residue, Count1 ), select_coins( not_light, Coins, Sample, Residue, Count2 ), select_coins( untested, Coins, Sample, Residue, Count3 ), select_coins( known_true, Coins, Sample, Residue, Count4 ), Count is Count1+Count2+Count3+Count4, Count =< 6, Checksum is Count1+(7*Count2)+(43*Count3)+(259*Count4), information_content( [Count1,Count2,Count3,Count4], Content ). table_information( Coins, Content ) :- count_coins( not_heavy, Coins, Count1 ), count_coins( not_light, Coins, Count2 ), count_coins( untested, Coins, Count3 ), count_coins( known_true, Coins, Count4 ), information_content( [Count1,Count2,Count3,Count4], Content ). count_coins( Part, Coins, Count ) :- part( Part, Coins, Selection ), length( Selection, Count ). </syntaxhighlight> === Updating what is known about the coins === ====draw_inferences( +Result, +Left, +Right, +Table, ?Coins )==== holds when <var>Result</var> is one of: * > (imbalance - left pan heavier), * < (imbalance - right pan heavier) or * <nowiki>=</nowiki> (pans balanced) from taking a weighing with the coin collections: <var>Left</var>, <var> Right</var> and <var>Table</var>. <var>Coins</var> is derived from this information using the following rules: * If the pans are unbalanced then only the previously untested or not_heavy coins on the lighter side of the balance are now not_heavy. Similarly, only the previously untested or not_light coins on the heavier side of the balance are now not_light. All the coins on the table are now known_true. * If the pans balance then all the coins weighed are known_true, with the coins on the <var>Table</var> left in their prior states. <syntaxhighlight lang="prolog"> draw_inferences( <, Left, Right, Table, Coins ) :- imbalance_inferences( Left, Right, Table, Coins ). draw_inferences( >, Left, Right, Table, Coins ) :- imbalance_inferences( Right, Left, Table, Coins ). draw_inferences( =, Left, Right, Table, Coins ) :- inference( [all(Left),known_true(Table),all(Right)], known_true( Coins ) ), inference( untested(Table), untested(Coins) ), inference( not_heavy(Table), not_heavy(Coins) ), inference( not_light(Table), not_light(Coins) ). </syntaxhighlight> ====imbalance_inferences( +Lighter, +Heavier, +Table, ?Coins )==== holds when: * All untested or not_heavy coins in <var>Lighter</var> are not_heavy in <var>Coins </var>; * All untested or not_light coins in <var>Heavier</var> are not_light in <var>Coins </var>; * All coins in <var>Table</var> are known_true in <var>Coins</var>; There are no untested coins in <var>Coins</var>. <syntaxhighlight lang="prolog"> imbalance_inferences( Lighter, Heavier, Table, Coins ) :- inference( [untested(Lighter),not_heavy(Lighter)], not_heavy(Coins) ), inference( [untested(Heavier),not_light(Heavier)], not_light(Coins) ), inference( [ known_true(Lighter), not_light(Lighter), known_true(Heavier), not_heavy(Heavier), all(Table) ], known_true(Coins) ), part( untested, Coins, [] ). </syntaxhighlight> ====inference( +CollectionA, ?CollectionB )==== holds when (part) <var>CollectionB</var> comprises the same coins as (part) <var>CollectionA</var>. <syntaxhighlight lang="prolog"> inference( CollectionA, CollectionB ) :- unfolded( CollectionA, Coins ), unfolded( CollectionB, Coins ). </syntaxhighlight> ====unfolded( +Collection, ?Coins )==== holds when (part) <var>Collection</var> comprises <var>Coins</var>. <syntaxhighlight lang="prolog"> unfolded( not_light(Collection), Coins ) :- part( not_light, Collection, Coins ). unfolded( not_heavy(Collection), Coins ) :- part( not_heavy, Collection, Coins ). unfolded( known_true(Collection), Coins ) :- part( known_true, Collection, Coins ). unfolded( untested(Collection), Coins ) :- part( untested, Collection, Coins ). unfolded( all(Collection), Coins ) :- collection_to_set( Collection, Coins ). unfolded( [Item|Items], Coins ) :- unfolded( Item, Value ), unfolded1( Items, Value, Coins ). unfolded1( [], Coins, Coins ). unfolded1( [Item|Items], Value, Coins ) :- unfolded( Item, Value0 ), ord_union( Value0, Value, Value1 ), unfolded1( Items, Value1, Coins ). </syntaxhighlight> ==Definite Clause Grammar== The following DCG represents the method for finding the counterfeit coin as a 'structured' procedure. <syntaxhighlight lang="prolog"> general_explanation( Procedure ) --> "Number the coins 1..12", newline, explanation( Procedure, 0 ). explanation( done(Coin, Weight), N ) --> tab( N ), "Conclude that the counterfeit coin is number ", literal( Coin ), ", which is ", literal( Weight ), newline. explanation( Step, N ) --> {step( Step, Left, Right, Table, Branches )}, tab( N ), "BEGIN", newline, tab( N ), "Put ", literal( Left ), " on the left-hand pan", newline, tab( N ), "Put ", literal( Right ), " on the right-hand pan", newline, tab( N ), "Leaving ", literal( Table ), " on the table", newline, branches_explained( Branches, N ), tab( N ), "END", newline. branches_explained( Branches, N ) --> next_step_explained( <, Branches, N ), next_step_explained( >, Branches, N ), next_step_explained( =, Branches, N ). next_step_explained( Result, Branch, N ) --> {branch( Result, Branch, Step )}, ( {var(Step)} -> "" | {nonvar(Step)} -> tab( N ), "If the ", literal( Result ), " then:", newline, explanation( Step, s(N) ) ). literal( 0 ) --> "0". literal( 1 ) --> "1". literal( 2 ) --> "2". literal( 3 ) --> "3". literal( 4 ) --> "4". literal( 5 ) --> "5". literal( 6 ) --> "6". literal( 7 ) --> "7". literal( 8 ) --> "8". literal( 9 ) --> "9". literal( 10 ) --> "10". literal( 11 ) --> "11". literal( 12 ) --> "12". literal( true ) --> "true". literal( heavy ) --> "heavy". literal( light ) --> "light". literal( = ) --> "pans balance". literal( < ) --> "right-hand pan is heavier". literal( > ) --> "left-hand pan is heavier". literal( Collection ) --> {collection_to_set( Collection , [H|T] )}, literal_set( T, H ). literal_set( [], Number ) --> "the coin numbered ", literal( Number ). literal_set( [H|T], Number ) --> "the coins numbered ", literal( Number ), literal_set1( T, H ). literal_set1( [], Number ) --> " and ", literal( Number ). literal_set1( [H|T], Number ) --> ", ", literal( Number ), literal_set1( T, H ). tab( 0 ) --> "". tab( s(N) ) --> " ", tab( N ). newline --> " ". </syntaxhighlight> ===Utility Predicates=== ====contains_coin( ?Collection, ?Coin )==== holds when <var>Coin</var> is a member of <var>Collection</var>. <syntaxhighlight lang="prolog"> contains_coin( Collection, Coin ) :- part( _Part, Collection, Coins ), member( Coin, Coins ). </syntaxhighlight> ====collection_to_set( +Collection, ?Set )==== holds when <var>Set</var> is the distributed union of the <code>known_true</code>, <code>not_heavy</code>, <code>not_light</code> and <code>untested</code> ordsets comprising <var>Collection</var>. <syntaxhighlight lang="prolog"> collection_to_set( Collection, Set ) :- part( known_true, Collection, KnownTrue ), part( not_heavy, Collection, NotHeavy ), part( not_light, Collection, NotLight ), part( untested, Collection, Untested ), ord_union( [KnownTrue,NotHeavy,NotLight,Untested], Set ). </syntaxhighlight> ==== information_content( +Counts, ?Content ) ==== holds when <var>Content</var> is the cumulative negative entropy of <var>Counts</var>. A reduction in entropy equates to a gain in information. <syntaxhighlight lang="prolog"> information_content( Counts, Content ) :- information_content1( Counts, 0, Content ). information_content1( [], Content, Content ). information_content1( [Count|Counts], Content0, Content ):- coins_entropy( Count, Entropy ), Content1 is Content0-Entropy, information_content1( Counts, Content1, Content ). </syntaxhighlight> ==== coins_entropy( ?N, ?Entropy ) ==== holds when <var>Entropy</var> estimates the entropy of a sample of <var>N</var> coins. <var>Entropy</var> = P log₂(1/P), where P = <var>N</var>/12. <syntaxhighlight lang="prolog"> coins_entropy( 0, 0.0 ). coins_entropy( 1, 0.2987 ). coins_entropy( 2, 0.4308 ). coins_entropy( 3, 0.5 ). coins_entropy( 4, 0.5283 ). coins_entropy( 5, 0.5263 ). coins_entropy( 6, 0.5 ). coins_entropy( 7, 0.4536 ). coins_entropy( 8, 0.39 ). coins_entropy( 9, 0.3113 ). coins_entropy( 10, 0.2192 ). coins_entropy( 11, 0.1151 ). coins_entropy( 12, 0.0 ). </syntaxhighlight> ====select_coins( +Part, +Count, ?Sample, ?Residue, ?Coins )==== <syntaxhighlight lang="prolog"> select_coins( Part, Coins, Sample, Residue, Count ) :- part( Part, Coins, Input ), part( Part, Sample, Selection ), part( Part, Residue, Remainder ), select_n( Count, Input, Selection, Remainder ). select_n( 0, In, [], In ). select_n( 1, [A|Suffix], [A], Suffix ). select_n( 2, [A,B|Suffix], [A,B], Suffix ). select_n( 3, [A,B,C|Suffix], [A,B,C], Suffix ). select_n( 4, [A,B,C,D|Suffix], [A,B,C,D], Suffix ). select_n( 5, [A,B,C,D,E|Suffix], [A,B,C,D,E], Suffix ). select_n( 6, [A,B,C,D,E,F|Suffix], [A,B,C,D,E,F], Suffix ). </syntaxhighlight> Load a small library of [puzzle utilities.] <syntaxhighlight lang="prolog"> :- ensure_loaded( misc ). </syntaxhighlight> Use the ordsets library. <syntaxhighlight lang="prolog"> :- use_module( library(ordsets), [ord_union/2,ord_union/3] ). </syntaxhighlight> ==Output== <div class="result"> Number the coins 1..12 BEGIN Put the coins numbered 1, 2, 3 and 4 on the left-hand pan Put the coins numbered 5, 6, 7 and 8 on the right-hand pan Leaving the coins numbered 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 1, 2, 5 and 6 on the left-hand pan Put the coins numbered 3, 7, 9 and 10 on the right-hand pan Leaving the coins numbered 4, 8, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 1 and 7 on the left-hand pan Put the coins numbered 3 and 4 on the right-hand pan Leaving the coins numbered 2, 5, 6, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 1, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 7, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 2, which is light END If the left-hand pan is heavier then: BEGIN Put the coins numbered 3 and 5 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 4, 6, 7, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 3, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 5, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 6, which is heavy END If the pans balance then: BEGIN Put the coins numbered 4 and 8 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 3, 5, 6, 7, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 4, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 8, which is heavy END END If the left-hand pan is heavier then: BEGIN Put the coins numbered 1, 2, 5 and 6 on the left-hand pan Put the coins numbered 3, 7, 9 and 10 on the right-hand pan Leaving the coins numbered 4, 8, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 3 and 5 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 4, 6, 7, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 5, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 3, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 6, which is light END If the left-hand pan is heavier then: BEGIN Put the coins numbered 1 and 7 on the left-hand pan Put the coins numbered 3 and 4 on the right-hand pan Leaving the coins numbered 2, 5, 6, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 7, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 1, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 2, which is heavy END If the pans balance then: BEGIN Put the coins numbered 4 and 8 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 3, 5, 6, 7, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 8, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 4, which is heavy END END If the pans balance then: BEGIN Put the coins numbered 9, 10 and 11 on the left-hand pan Put the coins numbered 1, 2 and 3 on the right-hand pan Leaving the coins numbered 4, 5, 6, 7, 8 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coin numbered 9 on the left-hand pan Put the coin numbered 10 on the right-hand pan Leaving the coins numbered 1, 2, 3, 4, 5, 6, 7, 8, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 9, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 10, which is light If the pans balance then: Conclude that the counterfeit coin is number 11, which is light END If the left-hand pan is heavier then: BEGIN Put the coin numbered 9 on the left-hand pan Put the coin numbered 10 on the right-hand pan Leaving the coins numbered 1, 2, 3, 4, 5, 6, 7, 8, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 10, which is heavy If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 9, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 11, which is heavy END If the pans balance then: BEGIN Put the coin numbered 12 on the left-hand pan Put the coin numbered 1 on the right-hand pan Leaving the coins numbered 2, 3, 4, 5, 6, 7, 8, 9, 10 and 11 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 12, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 12, which is heavy END END END </div> ---- ceab1009912b26c4dbdf99abbb530b89ec380d78 15 14 2013-06-21T22:40:01Z John 2 /* select_coins( +Part, +Count, ?Sample, ?Residue, ?Coins ) */ wikitext text/x-wiki __NOTOC__ ==Problem Definition== We are given 12 apparently identical coins - one of which is counterfeit. We know that the counterfeit has a different weight from the others, but we don't know if it's heavier or lighter. ===Task:=== Devise a procedure to identify any counterfeit coin using a balance to take up to three comparative weighings. ==Strategy== The information from three suitable weighings will make all but one of the 'coins', which are untested initially, 'known true'. There are three alternative deductions that make a coin 'known true': * if it is 'not heavy' and 'not light' - having been on both the comparatively lighter and heavier sides of imbalances; * if it was excluded from an imbalance; * if it was included in a balanced weighing. After three weighings there must be exactly one coin, the counterfeit, which is not 'true'. If the counterfeit is not true and 'not heavy' we deduce that it must be light. If it is not true and 'not light', it must be heavy. We use a 'generate-and-test' method as follows: * Create the set of all possible 'counterfeits': 12 coins &times; 2 weights ; * Devise a procedure that can identify the first counterfeit coin; * Show that the same procedure works for every other counterfeit. ==Entry Point== ====go==== is the entry point. It solves the puzzle, then uses a DCG to pretty-print the resulting procedure. <syntaxhighlight lang="prolog"> go :- coins_puzzle( Procedure ), phrase( general_explanation( Procedure ), Chars ), put_chars( Chars ). </syntaxhighlight> ====coins_puzzle( ?Procedure )==== generates the set of all possible 'counterfeits' and finds (or proves) that <var>Procedure</var> can identify them all. <syntaxhighlight lang="prolog"> coins_puzzle( Procedure ) :- coins( Coins ), counterfeit( Counterfeit, Coin, Weight ), findall( Counterfeit, (member(Coin,Coins), counterfeit_weight(Weight)), Counterfeits ), coins_puzzle_solution( Counterfeits, Procedure ). coins_puzzle_solution( [], _Procedure ). coins_puzzle_solution( [Counterfeit|Counterfeits], Procedure ) :- solve_coins( Counterfeit, Procedure ), coins_puzzle_solution( Counterfeits, Procedure ). </syntaxhighlight> A procedure is either 'done', identifying a particular coin and whether it is 'heavy' or 'light'; or it is a 'step'. A step defines the coins to be placed on the <var>Left</var> and <var>Right</var> pans, with the residue remaining on the <var>Table</var>, and three <var>Branches</var>, one of which will be chosen depending on the outcome of the weighing. <syntaxhighlight lang="prolog"> step( step(Left,Right,Table,Branches), Left, Right, Table, Branches). </syntaxhighlight> The <var>Branches</var> are three procedures equating to: * > (left pan heavier), * < (right pan heavier) and * <nowiki>= (pans balance).</nowiki> <syntaxhighlight lang="prolog"> branch( >, branches(_Equal, GT, _LT), GT ). branch( <, branches(_Equal, _GT, LT), LT ). branch( =, branches(Equal, _GT, _LT), Equal ). </syntaxhighlight> The counterfeit is defined by its number and whether it is heavy or light. <syntaxhighlight lang="prolog"> counterfeit( counterfeit(Coin, HeavyOrLight), Coin, HeavyOrLight ). coins( [1,2,3,4,5,6,7,8,9,10,11,12] ). counterfeit_weight( heavy ). counterfeit_weight( light ). </syntaxhighlight> A 'coin collection' comprises four 'parts' (subsets): the <code>known_true</code>, <code>not_heavy</code>, <code>not_light</code> and <code>untested</code> sets of coins. <syntaxhighlight lang="prolog"> part( known_true, collection(Coins,_,_,_), Coins ). part( not_heavy, collection(_,Coins,_,_), Coins ). part( not_light, collection(_,_,Coins,_), Coins ). part( untested, collection(_,_,_,Coins), Coins ). </syntaxhighlight> ==Solution== ====solve_coins( +Counterfeit, ?Procedure )==== holds when <var> Procedure</var> can correctly identify the <var>Counterfeit</var> coin. Beginning with a 'start' collection, in which all the coins are untested, the <var>Procedure</var> comprises three 'steps'. For each step a 'weighing' is made and a 'branch' is made in the <var>Procedure</var>, depending on the result of the weighing. After three steps, the <var>Procedure</var> must have reached the 'end' condition. Finally, an assertion (redundant test) ensures that the <var> Procedure</var> has found the correct end condition. <syntaxhighlight lang="prolog"> solve_coins( Counterfeit, Procedure ) :- start( Coins0 ), assay( Counterfeit, Coins0, Procedure, Branch1, Coins1 ), assay( Counterfeit, Coins1, Branch1, Branch2, Coins2 ), assay( Counterfeit, Coins2, Branch2, done(Coin, HeavyOrLight), Coins3 ), end( Coins3, Coin, HeavyOrLight ), counterfeit( Counterfeit, Coin, HeavyOrLight ). start( Coins ) :- coins( Untested ), part( untested, Coins, Untested ), part( not_heavy, Coins, [] ), part( not_light, Coins, [] ), part( known_true, Coins, [] ). end( Coins, Coin, HeavyOrLight ) :- part( untested, Coins, [] ), part( not_heavy, Coins, Light ), part( not_light, Coins, Heavy ), end_result( Heavy, Light, Coin, HeavyOrLight ). end_result( [Coin], [], Coin, heavy ). end_result( [], [Coin], Coin, light ). </syntaxhighlight> === Simulating the weighing process === ====assay( +Counterfeit, +Coins0, ?Step, ?Branch, ?Coins1 )==== holds when the appropriate <var>Branch</var> from <var>Step</var> is chosen by comparing the weights of two coin collections taken from the full set of coins: <var>Coins0</var>. <var>Coins1</var> is the full set of coins, updated with the inferences drawn from the weighing. <var>Counterfeit</var> is used to determine the result of the weighing. This predicate applies the critical insight into the solution of this puzzle: we have 24 (12 &times; 2) possible inputs to the procedure, with only 27 (3 &times; 3 &times; 3) possible outcomes from the weighings. Therefore, it is clear that each weighing must have a very high 'information content'. Choosing a weighing by information content makes the problem tractable. <syntaxhighlight lang="prolog"> assay( Counterfeit, Coins0, Step, Branch, Coins ) :- WeighingDatum = weighing_data(InfoContent, Left, Right, Table), step( Step, Left, Right, Table, Branches ), findall( WeighingDatum, valid_partition( Coins0, InfoContent, Left, Right, Table ), WeighingData ), sort( WeighingData, OrderedWeighingData ), member( WeighingDatum, OrderedWeighingData ), balance( Left, Right, Counterfeit, Result ), draw_inferences( Result, Left, Right, Table, Coins ), branch( Result, Branches, Branch ). </syntaxhighlight> ====balance( +Left, +Right, +Counterfeit, ? Result )==== holds when <var>Result</var> simulates the outcome of testing the coin collections <var>Left</var> and <var>Right</var> with a balance, where either may contain the <var>Counterfeit</var> coin. <syntaxhighlight lang="prolog"> balance( Left, Right, Counterfeit, Result ):- counterfeit( Counterfeit, Coin, Weight ), ( contains_coin( Left, Coin ) -> balance_result( Weight, normal, Result ) ; contains_coin( Right, Coin ) -> balance_result( normal, Weight, Result ) ; otherwise -> Result = '=' ). balance_result( light, normal, < ). balance_result( heavy, normal, > ). balance_result( normal, heavy, < ). balance_result( normal, light, > ). </syntaxhighlight> ===Choosing which coins to weigh=== ====valid_partition( +Coins, ?Content, ?Left, ?Right, ?Table )==== holds when <var>Coins</var> can be partitioned into three collections: <var>Left</var> side, <var>Right</var> side and <var>Table</var>; with the 'information content' of the partition given by <var>Content</var>. The definition of a 'valid partition' ensures that: * <var>Left</var> and <var>Right</var> must have the same number of coins (at least one); * <var>Left</var> cannot contain any known 'true' coins, because adding true coins to both sides creates redundant comparisons. A 'checksum' is used to ensure that only one member of each pair of symmetrical solutions can be generated. <syntaxhighlight lang="prolog"> valid_partition( Coins, Content, Left, Right, Table ):- part( known_true, Left, [] ), selection( Coins, Left, Coins1, Count, LeftChecksum, LeftInfo ), Count >= 1, selection( Coins1, Right, Table, Count, RightChecksum, RightInfo ), LeftChecksum =< RightChecksum, % Checksum to prevent symmetrical solutions table_information( Table, TableInfo ), sum( [LeftInfo,RightInfo,TableInfo], Content ). </syntaxhighlight> ====selection( +Coins, ?Sample, ?Residue, ?Count, ?Checksum, ?Content )==== holds when <var>Coins</var> is partitioned into two collections: <var>Sample</var> and <var>Residue</var>. <var>Count</var> is the number of coins in <var>Sample</var>. <var>Checksum</var> is a fingerprint for the mixture of coins in <var>Sample</var>, which has 'information content' <var>Content</var>. <syntaxhighlight lang="prolog"> selection( Coins, Sample, Residue, Count, Checksum, Content ) :- select_coins( not_heavy, Coins, Sample, Residue, Count1 ), select_coins( not_light, Coins, Sample, Residue, Count2 ), select_coins( untested, Coins, Sample, Residue, Count3 ), select_coins( known_true, Coins, Sample, Residue, Count4 ), Count is Count1+Count2+Count3+Count4, Count =< 6, Checksum is Count1+(7*Count2)+(43*Count3)+(259*Count4), information_content( [Count1,Count2,Count3,Count4], Content ). table_information( Coins, Content ) :- count_coins( not_heavy, Coins, Count1 ), count_coins( not_light, Coins, Count2 ), count_coins( untested, Coins, Count3 ), count_coins( known_true, Coins, Count4 ), information_content( [Count1,Count2,Count3,Count4], Content ). count_coins( Part, Coins, Count ) :- part( Part, Coins, Selection ), length( Selection, Count ). </syntaxhighlight> === Updating what is known about the coins === ====draw_inferences( +Result, +Left, +Right, +Table, ?Coins )==== holds when <var>Result</var> is one of: * > (imbalance - left pan heavier), * < (imbalance - right pan heavier) or * <nowiki>=</nowiki> (pans balanced) from taking a weighing with the coin collections: <var>Left</var>, <var> Right</var> and <var>Table</var>. <var>Coins</var> is derived from this information using the following rules: * If the pans are unbalanced then only the previously untested or not_heavy coins on the lighter side of the balance are now not_heavy. Similarly, only the previously untested or not_light coins on the heavier side of the balance are now not_light. All the coins on the table are now known_true. * If the pans balance then all the coins weighed are known_true, with the coins on the <var>Table</var> left in their prior states. <syntaxhighlight lang="prolog"> draw_inferences( <, Left, Right, Table, Coins ) :- imbalance_inferences( Left, Right, Table, Coins ). draw_inferences( >, Left, Right, Table, Coins ) :- imbalance_inferences( Right, Left, Table, Coins ). draw_inferences( =, Left, Right, Table, Coins ) :- inference( [all(Left),known_true(Table),all(Right)], known_true( Coins ) ), inference( untested(Table), untested(Coins) ), inference( not_heavy(Table), not_heavy(Coins) ), inference( not_light(Table), not_light(Coins) ). </syntaxhighlight> ====imbalance_inferences( +Lighter, +Heavier, +Table, ?Coins )==== holds when: * All untested or not_heavy coins in <var>Lighter</var> are not_heavy in <var>Coins </var>; * All untested or not_light coins in <var>Heavier</var> are not_light in <var>Coins </var>; * All coins in <var>Table</var> are known_true in <var>Coins</var>; There are no untested coins in <var>Coins</var>. <syntaxhighlight lang="prolog"> imbalance_inferences( Lighter, Heavier, Table, Coins ) :- inference( [untested(Lighter),not_heavy(Lighter)], not_heavy(Coins) ), inference( [untested(Heavier),not_light(Heavier)], not_light(Coins) ), inference( [ known_true(Lighter), not_light(Lighter), known_true(Heavier), not_heavy(Heavier), all(Table) ], known_true(Coins) ), part( untested, Coins, [] ). </syntaxhighlight> ====inference( +CollectionA, ?CollectionB )==== holds when (part) <var>CollectionB</var> comprises the same coins as (part) <var>CollectionA</var>. <syntaxhighlight lang="prolog"> inference( CollectionA, CollectionB ) :- unfolded( CollectionA, Coins ), unfolded( CollectionB, Coins ). </syntaxhighlight> ====unfolded( +Collection, ?Coins )==== holds when (part) <var>Collection</var> comprises <var>Coins</var>. <syntaxhighlight lang="prolog"> unfolded( not_light(Collection), Coins ) :- part( not_light, Collection, Coins ). unfolded( not_heavy(Collection), Coins ) :- part( not_heavy, Collection, Coins ). unfolded( known_true(Collection), Coins ) :- part( known_true, Collection, Coins ). unfolded( untested(Collection), Coins ) :- part( untested, Collection, Coins ). unfolded( all(Collection), Coins ) :- collection_to_set( Collection, Coins ). unfolded( [Item|Items], Coins ) :- unfolded( Item, Value ), unfolded1( Items, Value, Coins ). unfolded1( [], Coins, Coins ). unfolded1( [Item|Items], Value, Coins ) :- unfolded( Item, Value0 ), ord_union( Value0, Value, Value1 ), unfolded1( Items, Value1, Coins ). </syntaxhighlight> ==Definite Clause Grammar== The following DCG represents the method for finding the counterfeit coin as a 'structured' procedure. <syntaxhighlight lang="prolog"> general_explanation( Procedure ) --> "Number the coins 1..12", newline, explanation( Procedure, 0 ). explanation( done(Coin, Weight), N ) --> tab( N ), "Conclude that the counterfeit coin is number ", literal( Coin ), ", which is ", literal( Weight ), newline. explanation( Step, N ) --> {step( Step, Left, Right, Table, Branches )}, tab( N ), "BEGIN", newline, tab( N ), "Put ", literal( Left ), " on the left-hand pan", newline, tab( N ), "Put ", literal( Right ), " on the right-hand pan", newline, tab( N ), "Leaving ", literal( Table ), " on the table", newline, branches_explained( Branches, N ), tab( N ), "END", newline. branches_explained( Branches, N ) --> next_step_explained( <, Branches, N ), next_step_explained( >, Branches, N ), next_step_explained( =, Branches, N ). next_step_explained( Result, Branch, N ) --> {branch( Result, Branch, Step )}, ( {var(Step)} -> "" | {nonvar(Step)} -> tab( N ), "If the ", literal( Result ), " then:", newline, explanation( Step, s(N) ) ). literal( 0 ) --> "0". literal( 1 ) --> "1". literal( 2 ) --> "2". literal( 3 ) --> "3". literal( 4 ) --> "4". literal( 5 ) --> "5". literal( 6 ) --> "6". literal( 7 ) --> "7". literal( 8 ) --> "8". literal( 9 ) --> "9". literal( 10 ) --> "10". literal( 11 ) --> "11". literal( 12 ) --> "12". literal( true ) --> "true". literal( heavy ) --> "heavy". literal( light ) --> "light". literal( = ) --> "pans balance". literal( < ) --> "right-hand pan is heavier". literal( > ) --> "left-hand pan is heavier". literal( Collection ) --> {collection_to_set( Collection , [H|T] )}, literal_set( T, H ). literal_set( [], Number ) --> "the coin numbered ", literal( Number ). literal_set( [H|T], Number ) --> "the coins numbered ", literal( Number ), literal_set1( T, H ). literal_set1( [], Number ) --> " and ", literal( Number ). literal_set1( [H|T], Number ) --> ", ", literal( Number ), literal_set1( T, H ). tab( 0 ) --> "". tab( s(N) ) --> " ", tab( N ). newline --> " ". </syntaxhighlight> ===Utility Predicates=== ====contains_coin( ?Collection, ?Coin )==== holds when <var>Coin</var> is a member of <var>Collection</var>. <syntaxhighlight lang="prolog"> contains_coin( Collection, Coin ) :- part( _Part, Collection, Coins ), member( Coin, Coins ). </syntaxhighlight> ====collection_to_set( +Collection, ?Set )==== holds when <var>Set</var> is the distributed union of the <code>known_true</code>, <code>not_heavy</code>, <code>not_light</code> and <code>untested</code> ordsets comprising <var>Collection</var>. <syntaxhighlight lang="prolog"> collection_to_set( Collection, Set ) :- part( known_true, Collection, KnownTrue ), part( not_heavy, Collection, NotHeavy ), part( not_light, Collection, NotLight ), part( untested, Collection, Untested ), ord_union( [KnownTrue,NotHeavy,NotLight,Untested], Set ). </syntaxhighlight> ==== information_content( +Counts, ?Content ) ==== holds when <var>Content</var> is the cumulative negative entropy of <var>Counts</var>. A reduction in entropy equates to a gain in information. <syntaxhighlight lang="prolog"> information_content( Counts, Content ) :- information_content1( Counts, 0, Content ). information_content1( [], Content, Content ). information_content1( [Count|Counts], Content0, Content ):- coins_entropy( Count, Entropy ), Content1 is Content0-Entropy, information_content1( Counts, Content1, Content ). </syntaxhighlight> ==== coins_entropy( ?N, ?Entropy ) ==== holds when <var>Entropy</var> estimates the entropy of a sample of <var>N</var> coins. <var>Entropy</var> = P log₂(1/P), where P = <var>N</var>/12. <syntaxhighlight lang="prolog"> coins_entropy( 0, 0.0 ). coins_entropy( 1, 0.2987 ). coins_entropy( 2, 0.4308 ). coins_entropy( 3, 0.5 ). coins_entropy( 4, 0.5283 ). coins_entropy( 5, 0.5263 ). coins_entropy( 6, 0.5 ). coins_entropy( 7, 0.4536 ). coins_entropy( 8, 0.39 ). coins_entropy( 9, 0.3113 ). coins_entropy( 10, 0.2192 ). coins_entropy( 11, 0.1151 ). coins_entropy( 12, 0.0 ). </syntaxhighlight> ====select_coins( +Part, +Count, ?Sample, ?Residue, ?Coins )==== <syntaxhighlight lang="prolog"> select_coins( Part, Coins, Sample, Residue, Count ) :- part( Part, Coins, Input ), part( Part, Sample, Selection ), part( Part, Residue, Remainder ), select_n( Count, Input, Selection, Remainder ). select_n( 0, In, [], In ). select_n( 1, [A|Suffix], [A], Suffix ). select_n( 2, [A,B|Suffix], [A,B], Suffix ). select_n( 3, [A,B,C|Suffix], [A,B,C], Suffix ). select_n( 4, [A,B,C,D|Suffix], [A,B,C,D], Suffix ). select_n( 5, [A,B,C,D,E|Suffix], [A,B,C,D,E], Suffix ). select_n( 6, [A,B,C,D,E,F|Suffix], [A,B,C,D,E,F], Suffix ). </syntaxhighlight> Load a small library of [https://binding-time.co.uk/misc.html puzzle utilities]. <syntaxhighlight lang="prolog"> :- ensure_loaded( misc ). </syntaxhighlight> Use the ordsets library. <syntaxhighlight lang="prolog"> :- use_module( library(ordsets), [ord_union/2,ord_union/3] ). </syntaxhighlight> ==Output== <div class="result"> Number the coins 1..12 BEGIN Put the coins numbered 1, 2, 3 and 4 on the left-hand pan Put the coins numbered 5, 6, 7 and 8 on the right-hand pan Leaving the coins numbered 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 1, 2, 5 and 6 on the left-hand pan Put the coins numbered 3, 7, 9 and 10 on the right-hand pan Leaving the coins numbered 4, 8, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 1 and 7 on the left-hand pan Put the coins numbered 3 and 4 on the right-hand pan Leaving the coins numbered 2, 5, 6, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 1, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 7, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 2, which is light END If the left-hand pan is heavier then: BEGIN Put the coins numbered 3 and 5 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 4, 6, 7, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 3, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 5, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 6, which is heavy END If the pans balance then: BEGIN Put the coins numbered 4 and 8 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 3, 5, 6, 7, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 4, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 8, which is heavy END END If the left-hand pan is heavier then: BEGIN Put the coins numbered 1, 2, 5 and 6 on the left-hand pan Put the coins numbered 3, 7, 9 and 10 on the right-hand pan Leaving the coins numbered 4, 8, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 3 and 5 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 4, 6, 7, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 5, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 3, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 6, which is light END If the left-hand pan is heavier then: BEGIN Put the coins numbered 1 and 7 on the left-hand pan Put the coins numbered 3 and 4 on the right-hand pan Leaving the coins numbered 2, 5, 6, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 7, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 1, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 2, which is heavy END If the pans balance then: BEGIN Put the coins numbered 4 and 8 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 3, 5, 6, 7, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 8, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 4, which is heavy END END If the pans balance then: BEGIN Put the coins numbered 9, 10 and 11 on the left-hand pan Put the coins numbered 1, 2 and 3 on the right-hand pan Leaving the coins numbered 4, 5, 6, 7, 8 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coin numbered 9 on the left-hand pan Put the coin numbered 10 on the right-hand pan Leaving the coins numbered 1, 2, 3, 4, 5, 6, 7, 8, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 9, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 10, which is light If the pans balance then: Conclude that the counterfeit coin is number 11, which is light END If the left-hand pan is heavier then: BEGIN Put the coin numbered 9 on the left-hand pan Put the coin numbered 10 on the right-hand pan Leaving the coins numbered 1, 2, 3, 4, 5, 6, 7, 8, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 10, which is heavy If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 9, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 11, which is heavy END If the pans balance then: BEGIN Put the coin numbered 12 on the left-hand pan Put the coin numbered 1 on the right-hand pan Leaving the coins numbered 2, 3, 4, 5, 6, 7, 8, 9, 10 and 11 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 12, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 12, which is heavy END END END </div> ---- 083b2fb765f2288b26060b14fd07b4995011eb22 18 15 2013-07-11T15:20:00Z John 2 /* assay( +Counterfeit, +Coins0, ?Step, ?Branch, ?Coins1 ) */ wikitext text/x-wiki __NOTOC__ ==Problem Definition== We are given 12 apparently identical coins - one of which is counterfeit. We know that the counterfeit has a different weight from the others, but we don't know if it's heavier or lighter. ===Task:=== Devise a procedure to identify any counterfeit coin using a balance to take up to three comparative weighings. ==Strategy== The information from three suitable weighings will make all but one of the 'coins', which are untested initially, 'known true'. There are three alternative deductions that make a coin 'known true': * if it is 'not heavy' and 'not light' - having been on both the comparatively lighter and heavier sides of imbalances; * if it was excluded from an imbalance; * if it was included in a balanced weighing. After three weighings there must be exactly one coin, the counterfeit, which is not 'true'. If the counterfeit is not true and 'not heavy' we deduce that it must be light. If it is not true and 'not light', it must be heavy. We use a 'generate-and-test' method as follows: * Create the set of all possible 'counterfeits': 12 coins &times; 2 weights ; * Devise a procedure that can identify the first counterfeit coin; * Show that the same procedure works for every other counterfeit. ==Entry Point== ====go==== is the entry point. It solves the puzzle, then uses a DCG to pretty-print the resulting procedure. <syntaxhighlight lang="prolog"> go :- coins_puzzle( Procedure ), phrase( general_explanation( Procedure ), Chars ), put_chars( Chars ). </syntaxhighlight> ====coins_puzzle( ?Procedure )==== generates the set of all possible 'counterfeits' and finds (or proves) that <var>Procedure</var> can identify them all. <syntaxhighlight lang="prolog"> coins_puzzle( Procedure ) :- coins( Coins ), counterfeit( Counterfeit, Coin, Weight ), findall( Counterfeit, (member(Coin,Coins), counterfeit_weight(Weight)), Counterfeits ), coins_puzzle_solution( Counterfeits, Procedure ). coins_puzzle_solution( [], _Procedure ). coins_puzzle_solution( [Counterfeit|Counterfeits], Procedure ) :- solve_coins( Counterfeit, Procedure ), coins_puzzle_solution( Counterfeits, Procedure ). </syntaxhighlight> A procedure is either 'done', identifying a particular coin and whether it is 'heavy' or 'light'; or it is a 'step'. A step defines the coins to be placed on the <var>Left</var> and <var>Right</var> pans, with the residue remaining on the <var>Table</var>, and three <var>Branches</var>, one of which will be chosen depending on the outcome of the weighing. <syntaxhighlight lang="prolog"> step( step(Left,Right,Table,Branches), Left, Right, Table, Branches). </syntaxhighlight> The <var>Branches</var> are three procedures equating to: * > (left pan heavier), * < (right pan heavier) and * <nowiki>= (pans balance).</nowiki> <syntaxhighlight lang="prolog"> branch( >, branches(_Equal, GT, _LT), GT ). branch( <, branches(_Equal, _GT, LT), LT ). branch( =, branches(Equal, _GT, _LT), Equal ). </syntaxhighlight> The counterfeit is defined by its number and whether it is heavy or light. <syntaxhighlight lang="prolog"> counterfeit( counterfeit(Coin, HeavyOrLight), Coin, HeavyOrLight ). coins( [1,2,3,4,5,6,7,8,9,10,11,12] ). counterfeit_weight( heavy ). counterfeit_weight( light ). </syntaxhighlight> A 'coin collection' comprises four 'parts' (subsets): the <code>known_true</code>, <code>not_heavy</code>, <code>not_light</code> and <code>untested</code> sets of coins. <syntaxhighlight lang="prolog"> part( known_true, collection(Coins,_,_,_), Coins ). part( not_heavy, collection(_,Coins,_,_), Coins ). part( not_light, collection(_,_,Coins,_), Coins ). part( untested, collection(_,_,_,Coins), Coins ). </syntaxhighlight> ==Solution== ====solve_coins( +Counterfeit, ?Procedure )==== holds when <var> Procedure</var> can correctly identify the <var>Counterfeit</var> coin. Beginning with a 'start' collection, in which all the coins are untested, the <var>Procedure</var> comprises three 'steps'. For each step a 'weighing' is made and a 'branch' is made in the <var>Procedure</var>, depending on the result of the weighing. After three steps, the <var>Procedure</var> must have reached the 'end' condition. Finally, an assertion (redundant test) ensures that the <var> Procedure</var> has found the correct end condition. <syntaxhighlight lang="prolog"> solve_coins( Counterfeit, Procedure ) :- start( Coins0 ), assay( Counterfeit, Coins0, Procedure, Branch1, Coins1 ), assay( Counterfeit, Coins1, Branch1, Branch2, Coins2 ), assay( Counterfeit, Coins2, Branch2, done(Coin, HeavyOrLight), Coins3 ), end( Coins3, Coin, HeavyOrLight ), counterfeit( Counterfeit, Coin, HeavyOrLight ). start( Coins ) :- coins( Untested ), part( untested, Coins, Untested ), part( not_heavy, Coins, [] ), part( not_light, Coins, [] ), part( known_true, Coins, [] ). end( Coins, Coin, HeavyOrLight ) :- part( untested, Coins, [] ), part( not_heavy, Coins, Light ), part( not_light, Coins, Heavy ), end_result( Heavy, Light, Coin, HeavyOrLight ). end_result( [Coin], [], Coin, heavy ). end_result( [], [Coin], Coin, light ). </syntaxhighlight> === Simulating the weighing process === ====assay( +Counterfeit, +Coins0, ?Step, ?Branch, ?Coins1 )==== holds when the appropriate <var>Branch</var> from <var>Step</var> is chosen by comparing the weights of two coin collections taken from the full set of coins: <var>Coins0</var>. <var>Coins1</var> is the full set of coins, updated with the inferences drawn from the weighing. <var>Counterfeit</var> is used to determine the result of the weighing. This predicate applies the critical insight into the solution of this puzzle: we have 24 (12 &times; 2) possible inputs to the procedure, with only 27 (3 &times; 3 &times; 3) possible outcomes from the weighings. Therefore, it is clear that each weighing must have a very high 'information content'. Choosing which weighing to make by estimating the available information content makes the problem tractable. <syntaxhighlight lang="prolog"> assay( Counterfeit, Coins0, Step, Branch, Coins ) :- WeighingDatum = weighing_data(InfoContent, Left, Right, Table), step( Step, Left, Right, Table, Branches ), findall( WeighingDatum, valid_partition( Coins0, InfoContent, Left, Right, Table ), WeighingData ), sort( WeighingData, OrderedWeighingData ), member( WeighingDatum, OrderedWeighingData ), balance( Left, Right, Counterfeit, Result ), draw_inferences( Result, Left, Right, Table, Coins ), branch( Result, Branches, Branch ). </syntaxhighlight> ====balance( +Left, +Right, +Counterfeit, ? Result )==== holds when <var>Result</var> simulates the outcome of testing the coin collections <var>Left</var> and <var>Right</var> with a balance, where either may contain the <var>Counterfeit</var> coin. <syntaxhighlight lang="prolog"> balance( Left, Right, Counterfeit, Result ):- counterfeit( Counterfeit, Coin, Weight ), ( contains_coin( Left, Coin ) -> balance_result( Weight, normal, Result ) ; contains_coin( Right, Coin ) -> balance_result( normal, Weight, Result ) ; otherwise -> Result = '=' ). balance_result( light, normal, < ). balance_result( heavy, normal, > ). balance_result( normal, heavy, < ). balance_result( normal, light, > ). </syntaxhighlight> ===Choosing which coins to weigh=== ====valid_partition( +Coins, ?Content, ?Left, ?Right, ?Table )==== holds when <var>Coins</var> can be partitioned into three collections: <var>Left</var> side, <var>Right</var> side and <var>Table</var>; with the 'information content' of the partition given by <var>Content</var>. The definition of a 'valid partition' ensures that: * <var>Left</var> and <var>Right</var> must have the same number of coins (at least one); * <var>Left</var> cannot contain any known 'true' coins, because adding true coins to both sides creates redundant comparisons. A 'checksum' is used to ensure that only one member of each pair of symmetrical solutions can be generated. <syntaxhighlight lang="prolog"> valid_partition( Coins, Content, Left, Right, Table ):- part( known_true, Left, [] ), selection( Coins, Left, Coins1, Count, LeftChecksum, LeftInfo ), Count >= 1, selection( Coins1, Right, Table, Count, RightChecksum, RightInfo ), LeftChecksum =< RightChecksum, % Checksum to prevent symmetrical solutions table_information( Table, TableInfo ), sum( [LeftInfo,RightInfo,TableInfo], Content ). </syntaxhighlight> ====selection( +Coins, ?Sample, ?Residue, ?Count, ?Checksum, ?Content )==== holds when <var>Coins</var> is partitioned into two collections: <var>Sample</var> and <var>Residue</var>. <var>Count</var> is the number of coins in <var>Sample</var>. <var>Checksum</var> is a fingerprint for the mixture of coins in <var>Sample</var>, which has 'information content' <var>Content</var>. <syntaxhighlight lang="prolog"> selection( Coins, Sample, Residue, Count, Checksum, Content ) :- select_coins( not_heavy, Coins, Sample, Residue, Count1 ), select_coins( not_light, Coins, Sample, Residue, Count2 ), select_coins( untested, Coins, Sample, Residue, Count3 ), select_coins( known_true, Coins, Sample, Residue, Count4 ), Count is Count1+Count2+Count3+Count4, Count =< 6, Checksum is Count1+(7*Count2)+(43*Count3)+(259*Count4), information_content( [Count1,Count2,Count3,Count4], Content ). table_information( Coins, Content ) :- count_coins( not_heavy, Coins, Count1 ), count_coins( not_light, Coins, Count2 ), count_coins( untested, Coins, Count3 ), count_coins( known_true, Coins, Count4 ), information_content( [Count1,Count2,Count3,Count4], Content ). count_coins( Part, Coins, Count ) :- part( Part, Coins, Selection ), length( Selection, Count ). </syntaxhighlight> === Updating what is known about the coins === ====draw_inferences( +Result, +Left, +Right, +Table, ?Coins )==== holds when <var>Result</var> is one of: * > (imbalance - left pan heavier), * < (imbalance - right pan heavier) or * <nowiki>=</nowiki> (pans balanced) from taking a weighing with the coin collections: <var>Left</var>, <var> Right</var> and <var>Table</var>. <var>Coins</var> is derived from this information using the following rules: * If the pans are unbalanced then only the previously untested or not_heavy coins on the lighter side of the balance are now not_heavy. Similarly, only the previously untested or not_light coins on the heavier side of the balance are now not_light. All the coins on the table are now known_true. * If the pans balance then all the coins weighed are known_true, with the coins on the <var>Table</var> left in their prior states. <syntaxhighlight lang="prolog"> draw_inferences( <, Left, Right, Table, Coins ) :- imbalance_inferences( Left, Right, Table, Coins ). draw_inferences( >, Left, Right, Table, Coins ) :- imbalance_inferences( Right, Left, Table, Coins ). draw_inferences( =, Left, Right, Table, Coins ) :- inference( [all(Left),known_true(Table),all(Right)], known_true( Coins ) ), inference( untested(Table), untested(Coins) ), inference( not_heavy(Table), not_heavy(Coins) ), inference( not_light(Table), not_light(Coins) ). </syntaxhighlight> ====imbalance_inferences( +Lighter, +Heavier, +Table, ?Coins )==== holds when: * All untested or not_heavy coins in <var>Lighter</var> are not_heavy in <var>Coins </var>; * All untested or not_light coins in <var>Heavier</var> are not_light in <var>Coins </var>; * All coins in <var>Table</var> are known_true in <var>Coins</var>; There are no untested coins in <var>Coins</var>. <syntaxhighlight lang="prolog"> imbalance_inferences( Lighter, Heavier, Table, Coins ) :- inference( [untested(Lighter),not_heavy(Lighter)], not_heavy(Coins) ), inference( [untested(Heavier),not_light(Heavier)], not_light(Coins) ), inference( [ known_true(Lighter), not_light(Lighter), known_true(Heavier), not_heavy(Heavier), all(Table) ], known_true(Coins) ), part( untested, Coins, [] ). </syntaxhighlight> ====inference( +CollectionA, ?CollectionB )==== holds when (part) <var>CollectionB</var> comprises the same coins as (part) <var>CollectionA</var>. <syntaxhighlight lang="prolog"> inference( CollectionA, CollectionB ) :- unfolded( CollectionA, Coins ), unfolded( CollectionB, Coins ). </syntaxhighlight> ====unfolded( +Collection, ?Coins )==== holds when (part) <var>Collection</var> comprises <var>Coins</var>. <syntaxhighlight lang="prolog"> unfolded( not_light(Collection), Coins ) :- part( not_light, Collection, Coins ). unfolded( not_heavy(Collection), Coins ) :- part( not_heavy, Collection, Coins ). unfolded( known_true(Collection), Coins ) :- part( known_true, Collection, Coins ). unfolded( untested(Collection), Coins ) :- part( untested, Collection, Coins ). unfolded( all(Collection), Coins ) :- collection_to_set( Collection, Coins ). unfolded( [Item|Items], Coins ) :- unfolded( Item, Value ), unfolded1( Items, Value, Coins ). unfolded1( [], Coins, Coins ). unfolded1( [Item|Items], Value, Coins ) :- unfolded( Item, Value0 ), ord_union( Value0, Value, Value1 ), unfolded1( Items, Value1, Coins ). </syntaxhighlight> ==Definite Clause Grammar== The following DCG represents the method for finding the counterfeit coin as a 'structured' procedure. <syntaxhighlight lang="prolog"> general_explanation( Procedure ) --> "Number the coins 1..12", newline, explanation( Procedure, 0 ). explanation( done(Coin, Weight), N ) --> tab( N ), "Conclude that the counterfeit coin is number ", literal( Coin ), ", which is ", literal( Weight ), newline. explanation( Step, N ) --> {step( Step, Left, Right, Table, Branches )}, tab( N ), "BEGIN", newline, tab( N ), "Put ", literal( Left ), " on the left-hand pan", newline, tab( N ), "Put ", literal( Right ), " on the right-hand pan", newline, tab( N ), "Leaving ", literal( Table ), " on the table", newline, branches_explained( Branches, N ), tab( N ), "END", newline. branches_explained( Branches, N ) --> next_step_explained( <, Branches, N ), next_step_explained( >, Branches, N ), next_step_explained( =, Branches, N ). next_step_explained( Result, Branch, N ) --> {branch( Result, Branch, Step )}, ( {var(Step)} -> "" | {nonvar(Step)} -> tab( N ), "If the ", literal( Result ), " then:", newline, explanation( Step, s(N) ) ). literal( 0 ) --> "0". literal( 1 ) --> "1". literal( 2 ) --> "2". literal( 3 ) --> "3". literal( 4 ) --> "4". literal( 5 ) --> "5". literal( 6 ) --> "6". literal( 7 ) --> "7". literal( 8 ) --> "8". literal( 9 ) --> "9". literal( 10 ) --> "10". literal( 11 ) --> "11". literal( 12 ) --> "12". literal( true ) --> "true". literal( heavy ) --> "heavy". literal( light ) --> "light". literal( = ) --> "pans balance". literal( < ) --> "right-hand pan is heavier". literal( > ) --> "left-hand pan is heavier". literal( Collection ) --> {collection_to_set( Collection , [H|T] )}, literal_set( T, H ). literal_set( [], Number ) --> "the coin numbered ", literal( Number ). literal_set( [H|T], Number ) --> "the coins numbered ", literal( Number ), literal_set1( T, H ). literal_set1( [], Number ) --> " and ", literal( Number ). literal_set1( [H|T], Number ) --> ", ", literal( Number ), literal_set1( T, H ). tab( 0 ) --> "". tab( s(N) ) --> " ", tab( N ). newline --> " ". </syntaxhighlight> ===Utility Predicates=== ====contains_coin( ?Collection, ?Coin )==== holds when <var>Coin</var> is a member of <var>Collection</var>. <syntaxhighlight lang="prolog"> contains_coin( Collection, Coin ) :- part( _Part, Collection, Coins ), member( Coin, Coins ). </syntaxhighlight> ====collection_to_set( +Collection, ?Set )==== holds when <var>Set</var> is the distributed union of the <code>known_true</code>, <code>not_heavy</code>, <code>not_light</code> and <code>untested</code> ordsets comprising <var>Collection</var>. <syntaxhighlight lang="prolog"> collection_to_set( Collection, Set ) :- part( known_true, Collection, KnownTrue ), part( not_heavy, Collection, NotHeavy ), part( not_light, Collection, NotLight ), part( untested, Collection, Untested ), ord_union( [KnownTrue,NotHeavy,NotLight,Untested], Set ). </syntaxhighlight> ==== information_content( +Counts, ?Content ) ==== holds when <var>Content</var> is the cumulative negative entropy of <var>Counts</var>. A reduction in entropy equates to a gain in information. <syntaxhighlight lang="prolog"> information_content( Counts, Content ) :- information_content1( Counts, 0, Content ). information_content1( [], Content, Content ). information_content1( [Count|Counts], Content0, Content ):- coins_entropy( Count, Entropy ), Content1 is Content0-Entropy, information_content1( Counts, Content1, Content ). </syntaxhighlight> ==== coins_entropy( ?N, ?Entropy ) ==== holds when <var>Entropy</var> estimates the entropy of a sample of <var>N</var> coins. <var>Entropy</var> = P log₂(1/P), where P = <var>N</var>/12. <syntaxhighlight lang="prolog"> coins_entropy( 0, 0.0 ). coins_entropy( 1, 0.2987 ). coins_entropy( 2, 0.4308 ). coins_entropy( 3, 0.5 ). coins_entropy( 4, 0.5283 ). coins_entropy( 5, 0.5263 ). coins_entropy( 6, 0.5 ). coins_entropy( 7, 0.4536 ). coins_entropy( 8, 0.39 ). coins_entropy( 9, 0.3113 ). coins_entropy( 10, 0.2192 ). coins_entropy( 11, 0.1151 ). coins_entropy( 12, 0.0 ). </syntaxhighlight> ====select_coins( +Part, +Count, ?Sample, ?Residue, ?Coins )==== <syntaxhighlight lang="prolog"> select_coins( Part, Coins, Sample, Residue, Count ) :- part( Part, Coins, Input ), part( Part, Sample, Selection ), part( Part, Residue, Remainder ), select_n( Count, Input, Selection, Remainder ). select_n( 0, In, [], In ). select_n( 1, [A|Suffix], [A], Suffix ). select_n( 2, [A,B|Suffix], [A,B], Suffix ). select_n( 3, [A,B,C|Suffix], [A,B,C], Suffix ). select_n( 4, [A,B,C,D|Suffix], [A,B,C,D], Suffix ). select_n( 5, [A,B,C,D,E|Suffix], [A,B,C,D,E], Suffix ). select_n( 6, [A,B,C,D,E,F|Suffix], [A,B,C,D,E,F], Suffix ). </syntaxhighlight> Load a small library of [https://binding-time.co.uk/misc.html puzzle utilities]. <syntaxhighlight lang="prolog"> :- ensure_loaded( misc ). </syntaxhighlight> Use the ordsets library. <syntaxhighlight lang="prolog"> :- use_module( library(ordsets), [ord_union/2,ord_union/3] ). </syntaxhighlight> ==Output== <div class="result"> Number the coins 1..12 BEGIN Put the coins numbered 1, 2, 3 and 4 on the left-hand pan Put the coins numbered 5, 6, 7 and 8 on the right-hand pan Leaving the coins numbered 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 1, 2, 5 and 6 on the left-hand pan Put the coins numbered 3, 7, 9 and 10 on the right-hand pan Leaving the coins numbered 4, 8, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 1 and 7 on the left-hand pan Put the coins numbered 3 and 4 on the right-hand pan Leaving the coins numbered 2, 5, 6, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 1, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 7, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 2, which is light END If the left-hand pan is heavier then: BEGIN Put the coins numbered 3 and 5 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 4, 6, 7, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 3, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 5, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 6, which is heavy END If the pans balance then: BEGIN Put the coins numbered 4 and 8 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 3, 5, 6, 7, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 4, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 8, which is heavy END END If the left-hand pan is heavier then: BEGIN Put the coins numbered 1, 2, 5 and 6 on the left-hand pan Put the coins numbered 3, 7, 9 and 10 on the right-hand pan Leaving the coins numbered 4, 8, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 3 and 5 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 4, 6, 7, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 5, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 3, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 6, which is light END If the left-hand pan is heavier then: BEGIN Put the coins numbered 1 and 7 on the left-hand pan Put the coins numbered 3 and 4 on the right-hand pan Leaving the coins numbered 2, 5, 6, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 7, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 1, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 2, which is heavy END If the pans balance then: BEGIN Put the coins numbered 4 and 8 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 3, 5, 6, 7, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 8, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 4, which is heavy END END If the pans balance then: BEGIN Put the coins numbered 9, 10 and 11 on the left-hand pan Put the coins numbered 1, 2 and 3 on the right-hand pan Leaving the coins numbered 4, 5, 6, 7, 8 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coin numbered 9 on the left-hand pan Put the coin numbered 10 on the right-hand pan Leaving the coins numbered 1, 2, 3, 4, 5, 6, 7, 8, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 9, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 10, which is light If the pans balance then: Conclude that the counterfeit coin is number 11, which is light END If the left-hand pan is heavier then: BEGIN Put the coin numbered 9 on the left-hand pan Put the coin numbered 10 on the right-hand pan Leaving the coins numbered 1, 2, 3, 4, 5, 6, 7, 8, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 10, which is heavy If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 9, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 11, which is heavy END If the pans balance then: BEGIN Put the coin numbered 12 on the left-hand pan Put the coin numbered 1 on the right-hand pan Leaving the coins numbered 2, 3, 4, 5, 6, 7, 8, 9, 10 and 11 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 12, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 12, which is heavy END END END </div> ---- e3000e3dd149dac385518fcbf820f5fdd33cf3b1 19 18 2013-07-19T00:04:38Z John 2 /* select_coins( +Part, +Count, ?Sample, ?Residue, ?Coins ) */ wikitext text/x-wiki __NOTOC__ ==Problem Definition== We are given 12 apparently identical coins - one of which is counterfeit. We know that the counterfeit has a different weight from the others, but we don't know if it's heavier or lighter. ===Task:=== Devise a procedure to identify any counterfeit coin using a balance to take up to three comparative weighings. ==Strategy== The information from three suitable weighings will make all but one of the 'coins', which are untested initially, 'known true'. There are three alternative deductions that make a coin 'known true': * if it is 'not heavy' and 'not light' - having been on both the comparatively lighter and heavier sides of imbalances; * if it was excluded from an imbalance; * if it was included in a balanced weighing. After three weighings there must be exactly one coin, the counterfeit, which is not 'true'. If the counterfeit is not true and 'not heavy' we deduce that it must be light. If it is not true and 'not light', it must be heavy. We use a 'generate-and-test' method as follows: * Create the set of all possible 'counterfeits': 12 coins &times; 2 weights ; * Devise a procedure that can identify the first counterfeit coin; * Show that the same procedure works for every other counterfeit. ==Entry Point== ====go==== is the entry point. It solves the puzzle, then uses a DCG to pretty-print the resulting procedure. <syntaxhighlight lang="prolog"> go :- coins_puzzle( Procedure ), phrase( general_explanation( Procedure ), Chars ), put_chars( Chars ). </syntaxhighlight> ====coins_puzzle( ?Procedure )==== generates the set of all possible 'counterfeits' and finds (or proves) that <var>Procedure</var> can identify them all. <syntaxhighlight lang="prolog"> coins_puzzle( Procedure ) :- coins( Coins ), counterfeit( Counterfeit, Coin, Weight ), findall( Counterfeit, (member(Coin,Coins), counterfeit_weight(Weight)), Counterfeits ), coins_puzzle_solution( Counterfeits, Procedure ). coins_puzzle_solution( [], _Procedure ). coins_puzzle_solution( [Counterfeit|Counterfeits], Procedure ) :- solve_coins( Counterfeit, Procedure ), coins_puzzle_solution( Counterfeits, Procedure ). </syntaxhighlight> A procedure is either 'done', identifying a particular coin and whether it is 'heavy' or 'light'; or it is a 'step'. A step defines the coins to be placed on the <var>Left</var> and <var>Right</var> pans, with the residue remaining on the <var>Table</var>, and three <var>Branches</var>, one of which will be chosen depending on the outcome of the weighing. <syntaxhighlight lang="prolog"> step( step(Left,Right,Table,Branches), Left, Right, Table, Branches). </syntaxhighlight> The <var>Branches</var> are three procedures equating to: * > (left pan heavier), * < (right pan heavier) and * <nowiki>= (pans balance).</nowiki> <syntaxhighlight lang="prolog"> branch( >, branches(_Equal, GT, _LT), GT ). branch( <, branches(_Equal, _GT, LT), LT ). branch( =, branches(Equal, _GT, _LT), Equal ). </syntaxhighlight> The counterfeit is defined by its number and whether it is heavy or light. <syntaxhighlight lang="prolog"> counterfeit( counterfeit(Coin, HeavyOrLight), Coin, HeavyOrLight ). coins( [1,2,3,4,5,6,7,8,9,10,11,12] ). counterfeit_weight( heavy ). counterfeit_weight( light ). </syntaxhighlight> A 'coin collection' comprises four 'parts' (subsets): the <code>known_true</code>, <code>not_heavy</code>, <code>not_light</code> and <code>untested</code> sets of coins. <syntaxhighlight lang="prolog"> part( known_true, collection(Coins,_,_,_), Coins ). part( not_heavy, collection(_,Coins,_,_), Coins ). part( not_light, collection(_,_,Coins,_), Coins ). part( untested, collection(_,_,_,Coins), Coins ). </syntaxhighlight> ==Solution== ====solve_coins( +Counterfeit, ?Procedure )==== holds when <var> Procedure</var> can correctly identify the <var>Counterfeit</var> coin. Beginning with a 'start' collection, in which all the coins are untested, the <var>Procedure</var> comprises three 'steps'. For each step a 'weighing' is made and a 'branch' is made in the <var>Procedure</var>, depending on the result of the weighing. After three steps, the <var>Procedure</var> must have reached the 'end' condition. Finally, an assertion (redundant test) ensures that the <var> Procedure</var> has found the correct end condition. <syntaxhighlight lang="prolog"> solve_coins( Counterfeit, Procedure ) :- start( Coins0 ), assay( Counterfeit, Coins0, Procedure, Branch1, Coins1 ), assay( Counterfeit, Coins1, Branch1, Branch2, Coins2 ), assay( Counterfeit, Coins2, Branch2, done(Coin, HeavyOrLight), Coins3 ), end( Coins3, Coin, HeavyOrLight ), counterfeit( Counterfeit, Coin, HeavyOrLight ). start( Coins ) :- coins( Untested ), part( untested, Coins, Untested ), part( not_heavy, Coins, [] ), part( not_light, Coins, [] ), part( known_true, Coins, [] ). end( Coins, Coin, HeavyOrLight ) :- part( untested, Coins, [] ), part( not_heavy, Coins, Light ), part( not_light, Coins, Heavy ), end_result( Heavy, Light, Coin, HeavyOrLight ). end_result( [Coin], [], Coin, heavy ). end_result( [], [Coin], Coin, light ). </syntaxhighlight> === Simulating the weighing process === ====assay( +Counterfeit, +Coins0, ?Step, ?Branch, ?Coins1 )==== holds when the appropriate <var>Branch</var> from <var>Step</var> is chosen by comparing the weights of two coin collections taken from the full set of coins: <var>Coins0</var>. <var>Coins1</var> is the full set of coins, updated with the inferences drawn from the weighing. <var>Counterfeit</var> is used to determine the result of the weighing. This predicate applies the critical insight into the solution of this puzzle: we have 24 (12 &times; 2) possible inputs to the procedure, with only 27 (3 &times; 3 &times; 3) possible outcomes from the weighings. Therefore, it is clear that each weighing must have a very high 'information content'. Choosing which weighing to make by estimating the available information content makes the problem tractable. <syntaxhighlight lang="prolog"> assay( Counterfeit, Coins0, Step, Branch, Coins ) :- WeighingDatum = weighing_data(InfoContent, Left, Right, Table), step( Step, Left, Right, Table, Branches ), findall( WeighingDatum, valid_partition( Coins0, InfoContent, Left, Right, Table ), WeighingData ), sort( WeighingData, OrderedWeighingData ), member( WeighingDatum, OrderedWeighingData ), balance( Left, Right, Counterfeit, Result ), draw_inferences( Result, Left, Right, Table, Coins ), branch( Result, Branches, Branch ). </syntaxhighlight> ====balance( +Left, +Right, +Counterfeit, ? Result )==== holds when <var>Result</var> simulates the outcome of testing the coin collections <var>Left</var> and <var>Right</var> with a balance, where either may contain the <var>Counterfeit</var> coin. <syntaxhighlight lang="prolog"> balance( Left, Right, Counterfeit, Result ):- counterfeit( Counterfeit, Coin, Weight ), ( contains_coin( Left, Coin ) -> balance_result( Weight, normal, Result ) ; contains_coin( Right, Coin ) -> balance_result( normal, Weight, Result ) ; otherwise -> Result = '=' ). balance_result( light, normal, < ). balance_result( heavy, normal, > ). balance_result( normal, heavy, < ). balance_result( normal, light, > ). </syntaxhighlight> ===Choosing which coins to weigh=== ====valid_partition( +Coins, ?Content, ?Left, ?Right, ?Table )==== holds when <var>Coins</var> can be partitioned into three collections: <var>Left</var> side, <var>Right</var> side and <var>Table</var>; with the 'information content' of the partition given by <var>Content</var>. The definition of a 'valid partition' ensures that: * <var>Left</var> and <var>Right</var> must have the same number of coins (at least one); * <var>Left</var> cannot contain any known 'true' coins, because adding true coins to both sides creates redundant comparisons. A 'checksum' is used to ensure that only one member of each pair of symmetrical solutions can be generated. <syntaxhighlight lang="prolog"> valid_partition( Coins, Content, Left, Right, Table ):- part( known_true, Left, [] ), selection( Coins, Left, Coins1, Count, LeftChecksum, LeftInfo ), Count >= 1, selection( Coins1, Right, Table, Count, RightChecksum, RightInfo ), LeftChecksum =< RightChecksum, % Checksum to prevent symmetrical solutions table_information( Table, TableInfo ), sum( [LeftInfo,RightInfo,TableInfo], Content ). </syntaxhighlight> ====selection( +Coins, ?Sample, ?Residue, ?Count, ?Checksum, ?Content )==== holds when <var>Coins</var> is partitioned into two collections: <var>Sample</var> and <var>Residue</var>. <var>Count</var> is the number of coins in <var>Sample</var>. <var>Checksum</var> is a fingerprint for the mixture of coins in <var>Sample</var>, which has 'information content' <var>Content</var>. <syntaxhighlight lang="prolog"> selection( Coins, Sample, Residue, Count, Checksum, Content ) :- select_coins( not_heavy, Coins, Sample, Residue, Count1 ), select_coins( not_light, Coins, Sample, Residue, Count2 ), select_coins( untested, Coins, Sample, Residue, Count3 ), select_coins( known_true, Coins, Sample, Residue, Count4 ), Count is Count1+Count2+Count3+Count4, Count =< 6, Checksum is Count1+(7*Count2)+(43*Count3)+(259*Count4), information_content( [Count1,Count2,Count3,Count4], Content ). table_information( Coins, Content ) :- count_coins( not_heavy, Coins, Count1 ), count_coins( not_light, Coins, Count2 ), count_coins( untested, Coins, Count3 ), count_coins( known_true, Coins, Count4 ), information_content( [Count1,Count2,Count3,Count4], Content ). count_coins( Part, Coins, Count ) :- part( Part, Coins, Selection ), length( Selection, Count ). </syntaxhighlight> === Updating what is known about the coins === ====draw_inferences( +Result, +Left, +Right, +Table, ?Coins )==== holds when <var>Result</var> is one of: * > (imbalance - left pan heavier), * < (imbalance - right pan heavier) or * <nowiki>=</nowiki> (pans balanced) from taking a weighing with the coin collections: <var>Left</var>, <var> Right</var> and <var>Table</var>. <var>Coins</var> is derived from this information using the following rules: * If the pans are unbalanced then only the previously untested or not_heavy coins on the lighter side of the balance are now not_heavy. Similarly, only the previously untested or not_light coins on the heavier side of the balance are now not_light. All the coins on the table are now known_true. * If the pans balance then all the coins weighed are known_true, with the coins on the <var>Table</var> left in their prior states. <syntaxhighlight lang="prolog"> draw_inferences( <, Left, Right, Table, Coins ) :- imbalance_inferences( Left, Right, Table, Coins ). draw_inferences( >, Left, Right, Table, Coins ) :- imbalance_inferences( Right, Left, Table, Coins ). draw_inferences( =, Left, Right, Table, Coins ) :- inference( [all(Left),known_true(Table),all(Right)], known_true( Coins ) ), inference( untested(Table), untested(Coins) ), inference( not_heavy(Table), not_heavy(Coins) ), inference( not_light(Table), not_light(Coins) ). </syntaxhighlight> ====imbalance_inferences( +Lighter, +Heavier, +Table, ?Coins )==== holds when: * All untested or not_heavy coins in <var>Lighter</var> are not_heavy in <var>Coins </var>; * All untested or not_light coins in <var>Heavier</var> are not_light in <var>Coins </var>; * All coins in <var>Table</var> are known_true in <var>Coins</var>; There are no untested coins in <var>Coins</var>. <syntaxhighlight lang="prolog"> imbalance_inferences( Lighter, Heavier, Table, Coins ) :- inference( [untested(Lighter),not_heavy(Lighter)], not_heavy(Coins) ), inference( [untested(Heavier),not_light(Heavier)], not_light(Coins) ), inference( [ known_true(Lighter), not_light(Lighter), known_true(Heavier), not_heavy(Heavier), all(Table) ], known_true(Coins) ), part( untested, Coins, [] ). </syntaxhighlight> ====inference( +CollectionA, ?CollectionB )==== holds when (part) <var>CollectionB</var> comprises the same coins as (part) <var>CollectionA</var>. <syntaxhighlight lang="prolog"> inference( CollectionA, CollectionB ) :- unfolded( CollectionA, Coins ), unfolded( CollectionB, Coins ). </syntaxhighlight> ====unfolded( +Collection, ?Coins )==== holds when (part) <var>Collection</var> comprises <var>Coins</var>. <syntaxhighlight lang="prolog"> unfolded( not_light(Collection), Coins ) :- part( not_light, Collection, Coins ). unfolded( not_heavy(Collection), Coins ) :- part( not_heavy, Collection, Coins ). unfolded( known_true(Collection), Coins ) :- part( known_true, Collection, Coins ). unfolded( untested(Collection), Coins ) :- part( untested, Collection, Coins ). unfolded( all(Collection), Coins ) :- collection_to_set( Collection, Coins ). unfolded( [Item|Items], Coins ) :- unfolded( Item, Value ), unfolded1( Items, Value, Coins ). unfolded1( [], Coins, Coins ). unfolded1( [Item|Items], Value, Coins ) :- unfolded( Item, Value0 ), ord_union( Value0, Value, Value1 ), unfolded1( Items, Value1, Coins ). </syntaxhighlight> ==Definite Clause Grammar== The following DCG represents the method for finding the counterfeit coin as a 'structured' procedure. <syntaxhighlight lang="prolog"> general_explanation( Procedure ) --> "Number the coins 1..12", newline, explanation( Procedure, 0 ). explanation( done(Coin, Weight), N ) --> tab( N ), "Conclude that the counterfeit coin is number ", literal( Coin ), ", which is ", literal( Weight ), newline. explanation( Step, N ) --> {step( Step, Left, Right, Table, Branches )}, tab( N ), "BEGIN", newline, tab( N ), "Put ", literal( Left ), " on the left-hand pan", newline, tab( N ), "Put ", literal( Right ), " on the right-hand pan", newline, tab( N ), "Leaving ", literal( Table ), " on the table", newline, branches_explained( Branches, N ), tab( N ), "END", newline. branches_explained( Branches, N ) --> next_step_explained( <, Branches, N ), next_step_explained( >, Branches, N ), next_step_explained( =, Branches, N ). next_step_explained( Result, Branch, N ) --> {branch( Result, Branch, Step )}, ( {var(Step)} -> "" | {nonvar(Step)} -> tab( N ), "If the ", literal( Result ), " then:", newline, explanation( Step, s(N) ) ). literal( 0 ) --> "0". literal( 1 ) --> "1". literal( 2 ) --> "2". literal( 3 ) --> "3". literal( 4 ) --> "4". literal( 5 ) --> "5". literal( 6 ) --> "6". literal( 7 ) --> "7". literal( 8 ) --> "8". literal( 9 ) --> "9". literal( 10 ) --> "10". literal( 11 ) --> "11". literal( 12 ) --> "12". literal( true ) --> "true". literal( heavy ) --> "heavy". literal( light ) --> "light". literal( = ) --> "pans balance". literal( < ) --> "right-hand pan is heavier". literal( > ) --> "left-hand pan is heavier". literal( Collection ) --> {collection_to_set( Collection , [H|T] )}, literal_set( T, H ). literal_set( [], Number ) --> "the coin numbered ", literal( Number ). literal_set( [H|T], Number ) --> "the coins numbered ", literal( Number ), literal_set1( T, H ). literal_set1( [], Number ) --> " and ", literal( Number ). literal_set1( [H|T], Number ) --> ", ", literal( Number ), literal_set1( T, H ). tab( 0 ) --> "". tab( s(N) ) --> " ", tab( N ). newline --> " ". </syntaxhighlight> ===Utility Predicates=== ====contains_coin( ?Collection, ?Coin )==== holds when <var>Coin</var> is a member of <var>Collection</var>. <syntaxhighlight lang="prolog"> contains_coin( Collection, Coin ) :- part( _Part, Collection, Coins ), member( Coin, Coins ). </syntaxhighlight> ====collection_to_set( +Collection, ?Set )==== holds when <var>Set</var> is the distributed union of the <code>known_true</code>, <code>not_heavy</code>, <code>not_light</code> and <code>untested</code> ordsets comprising <var>Collection</var>. <syntaxhighlight lang="prolog"> collection_to_set( Collection, Set ) :- part( known_true, Collection, KnownTrue ), part( not_heavy, Collection, NotHeavy ), part( not_light, Collection, NotLight ), part( untested, Collection, Untested ), ord_union( [KnownTrue,NotHeavy,NotLight,Untested], Set ). </syntaxhighlight> ==== information_content( +Counts, ?Content ) ==== holds when <var>Content</var> is the cumulative negative entropy of <var>Counts</var>. A reduction in entropy equates to a gain in information. <syntaxhighlight lang="prolog"> information_content( Counts, Content ) :- information_content1( Counts, 0, Content ). information_content1( [], Content, Content ). information_content1( [Count|Counts], Content0, Content ):- coins_entropy( Count, Entropy ), Content1 is Content0-Entropy, information_content1( Counts, Content1, Content ). </syntaxhighlight> ==== coins_entropy( ?N, ?Entropy ) ==== holds when <var>Entropy</var> estimates the entropy of a sample of <var>N</var> coins. <var>Entropy</var> = P log₂(1/P), where P = <var>N</var>/12. <syntaxhighlight lang="prolog"> coins_entropy( 0, 0.0 ). coins_entropy( 1, 0.2987 ). coins_entropy( 2, 0.4308 ). coins_entropy( 3, 0.5 ). coins_entropy( 4, 0.5283 ). coins_entropy( 5, 0.5263 ). coins_entropy( 6, 0.5 ). coins_entropy( 7, 0.4536 ). coins_entropy( 8, 0.39 ). coins_entropy( 9, 0.3113 ). coins_entropy( 10, 0.2192 ). coins_entropy( 11, 0.1151 ). coins_entropy( 12, 0.0 ). </syntaxhighlight> ====select_coins( +Part, +Coins, ?Sample, ?Residue, ?N )==== holds when <var>N</var> coins from <var>Part</var> of <var>Coins</var> form <var>Part</var> of <var>Sample</var>, with the remainder forming <var>Part</var> of <var>Residue</var>. <syntaxhighlight lang="prolog"> select_coins( Part, Coins, Sample, Residue, Count ) :- part( Part, Coins, Input ), part( Part, Sample, Selection ), part( Part, Residue, Remainder ), select_n( Count, Input, Selection, Remainder ). select_n( 0, In, [], In ). select_n( 1, [A|Suffix], [A], Suffix ). select_n( 2, [A,B|Suffix], [A,B], Suffix ). select_n( 3, [A,B,C|Suffix], [A,B,C], Suffix ). select_n( 4, [A,B,C,D|Suffix], [A,B,C,D], Suffix ). select_n( 5, [A,B,C,D,E|Suffix], [A,B,C,D,E], Suffix ). select_n( 6, [A,B,C,D,E,F|Suffix], [A,B,C,D,E,F], Suffix ). </syntaxhighlight> Load a small library of [https://binding-time.co.uk/misc.html puzzle utilities]. <syntaxhighlight lang="prolog"> :- ensure_loaded( misc ). </syntaxhighlight> Use the ordsets library. <syntaxhighlight lang="prolog"> :- use_module( library(ordsets), [ord_union/2,ord_union/3] ). </syntaxhighlight> The code is available as plain text [[https://binding-time.co.uk/counterfeit.txt here]]. ==Output== <div class="result"> Number the coins 1..12 BEGIN Put the coins numbered 1, 2, 3 and 4 on the left-hand pan Put the coins numbered 5, 6, 7 and 8 on the right-hand pan Leaving the coins numbered 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 1, 2, 5 and 6 on the left-hand pan Put the coins numbered 3, 7, 9 and 10 on the right-hand pan Leaving the coins numbered 4, 8, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 1 and 7 on the left-hand pan Put the coins numbered 3 and 4 on the right-hand pan Leaving the coins numbered 2, 5, 6, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 1, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 7, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 2, which is light END If the left-hand pan is heavier then: BEGIN Put the coins numbered 3 and 5 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 4, 6, 7, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 3, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 5, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 6, which is heavy END If the pans balance then: BEGIN Put the coins numbered 4 and 8 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 3, 5, 6, 7, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 4, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 8, which is heavy END END If the left-hand pan is heavier then: BEGIN Put the coins numbered 1, 2, 5 and 6 on the left-hand pan Put the coins numbered 3, 7, 9 and 10 on the right-hand pan Leaving the coins numbered 4, 8, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 3 and 5 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 4, 6, 7, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 5, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 3, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 6, which is light END If the left-hand pan is heavier then: BEGIN Put the coins numbered 1 and 7 on the left-hand pan Put the coins numbered 3 and 4 on the right-hand pan Leaving the coins numbered 2, 5, 6, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 7, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 1, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 2, which is heavy END If the pans balance then: BEGIN Put the coins numbered 4 and 8 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 3, 5, 6, 7, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 8, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 4, which is heavy END END If the pans balance then: BEGIN Put the coins numbered 9, 10 and 11 on the left-hand pan Put the coins numbered 1, 2 and 3 on the right-hand pan Leaving the coins numbered 4, 5, 6, 7, 8 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coin numbered 9 on the left-hand pan Put the coin numbered 10 on the right-hand pan Leaving the coins numbered 1, 2, 3, 4, 5, 6, 7, 8, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 9, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 10, which is light If the pans balance then: Conclude that the counterfeit coin is number 11, which is light END If the left-hand pan is heavier then: BEGIN Put the coin numbered 9 on the left-hand pan Put the coin numbered 10 on the right-hand pan Leaving the coins numbered 1, 2, 3, 4, 5, 6, 7, 8, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 10, which is heavy If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 9, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 11, which is heavy END If the pans balance then: BEGIN Put the coin numbered 12 on the left-hand pan Put the coin numbered 1 on the right-hand pan Leaving the coins numbered 2, 3, 4, 5, 6, 7, 8, 9, 10 and 11 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 12, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 12, which is heavy END END END </div> ---- 142187e8101fa208f57453572d141c851bb53a3b 20 19 2013-07-19T00:05:54Z John 2 /* select_coins( +Part, +Coins, ?Sample, ?Residue, ?N ) */ wikitext text/x-wiki __NOTOC__ ==Problem Definition== We are given 12 apparently identical coins - one of which is counterfeit. We know that the counterfeit has a different weight from the others, but we don't know if it's heavier or lighter. ===Task:=== Devise a procedure to identify any counterfeit coin using a balance to take up to three comparative weighings. ==Strategy== The information from three suitable weighings will make all but one of the 'coins', which are untested initially, 'known true'. There are three alternative deductions that make a coin 'known true': * if it is 'not heavy' and 'not light' - having been on both the comparatively lighter and heavier sides of imbalances; * if it was excluded from an imbalance; * if it was included in a balanced weighing. After three weighings there must be exactly one coin, the counterfeit, which is not 'true'. If the counterfeit is not true and 'not heavy' we deduce that it must be light. If it is not true and 'not light', it must be heavy. We use a 'generate-and-test' method as follows: * Create the set of all possible 'counterfeits': 12 coins &times; 2 weights ; * Devise a procedure that can identify the first counterfeit coin; * Show that the same procedure works for every other counterfeit. ==Entry Point== ====go==== is the entry point. It solves the puzzle, then uses a DCG to pretty-print the resulting procedure. <syntaxhighlight lang="prolog"> go :- coins_puzzle( Procedure ), phrase( general_explanation( Procedure ), Chars ), put_chars( Chars ). </syntaxhighlight> ====coins_puzzle( ?Procedure )==== generates the set of all possible 'counterfeits' and finds (or proves) that <var>Procedure</var> can identify them all. <syntaxhighlight lang="prolog"> coins_puzzle( Procedure ) :- coins( Coins ), counterfeit( Counterfeit, Coin, Weight ), findall( Counterfeit, (member(Coin,Coins), counterfeit_weight(Weight)), Counterfeits ), coins_puzzle_solution( Counterfeits, Procedure ). coins_puzzle_solution( [], _Procedure ). coins_puzzle_solution( [Counterfeit|Counterfeits], Procedure ) :- solve_coins( Counterfeit, Procedure ), coins_puzzle_solution( Counterfeits, Procedure ). </syntaxhighlight> A procedure is either 'done', identifying a particular coin and whether it is 'heavy' or 'light'; or it is a 'step'. A step defines the coins to be placed on the <var>Left</var> and <var>Right</var> pans, with the residue remaining on the <var>Table</var>, and three <var>Branches</var>, one of which will be chosen depending on the outcome of the weighing. <syntaxhighlight lang="prolog"> step( step(Left,Right,Table,Branches), Left, Right, Table, Branches). </syntaxhighlight> The <var>Branches</var> are three procedures equating to: * > (left pan heavier), * < (right pan heavier) and * <nowiki>= (pans balance).</nowiki> <syntaxhighlight lang="prolog"> branch( >, branches(_Equal, GT, _LT), GT ). branch( <, branches(_Equal, _GT, LT), LT ). branch( =, branches(Equal, _GT, _LT), Equal ). </syntaxhighlight> The counterfeit is defined by its number and whether it is heavy or light. <syntaxhighlight lang="prolog"> counterfeit( counterfeit(Coin, HeavyOrLight), Coin, HeavyOrLight ). coins( [1,2,3,4,5,6,7,8,9,10,11,12] ). counterfeit_weight( heavy ). counterfeit_weight( light ). </syntaxhighlight> A 'coin collection' comprises four 'parts' (subsets): the <code>known_true</code>, <code>not_heavy</code>, <code>not_light</code> and <code>untested</code> sets of coins. <syntaxhighlight lang="prolog"> part( known_true, collection(Coins,_,_,_), Coins ). part( not_heavy, collection(_,Coins,_,_), Coins ). part( not_light, collection(_,_,Coins,_), Coins ). part( untested, collection(_,_,_,Coins), Coins ). </syntaxhighlight> ==Solution== ====solve_coins( +Counterfeit, ?Procedure )==== holds when <var> Procedure</var> can correctly identify the <var>Counterfeit</var> coin. Beginning with a 'start' collection, in which all the coins are untested, the <var>Procedure</var> comprises three 'steps'. For each step a 'weighing' is made and a 'branch' is made in the <var>Procedure</var>, depending on the result of the weighing. After three steps, the <var>Procedure</var> must have reached the 'end' condition. Finally, an assertion (redundant test) ensures that the <var> Procedure</var> has found the correct end condition. <syntaxhighlight lang="prolog"> solve_coins( Counterfeit, Procedure ) :- start( Coins0 ), assay( Counterfeit, Coins0, Procedure, Branch1, Coins1 ), assay( Counterfeit, Coins1, Branch1, Branch2, Coins2 ), assay( Counterfeit, Coins2, Branch2, done(Coin, HeavyOrLight), Coins3 ), end( Coins3, Coin, HeavyOrLight ), counterfeit( Counterfeit, Coin, HeavyOrLight ). start( Coins ) :- coins( Untested ), part( untested, Coins, Untested ), part( not_heavy, Coins, [] ), part( not_light, Coins, [] ), part( known_true, Coins, [] ). end( Coins, Coin, HeavyOrLight ) :- part( untested, Coins, [] ), part( not_heavy, Coins, Light ), part( not_light, Coins, Heavy ), end_result( Heavy, Light, Coin, HeavyOrLight ). end_result( [Coin], [], Coin, heavy ). end_result( [], [Coin], Coin, light ). </syntaxhighlight> === Simulating the weighing process === ====assay( +Counterfeit, +Coins0, ?Step, ?Branch, ?Coins1 )==== holds when the appropriate <var>Branch</var> from <var>Step</var> is chosen by comparing the weights of two coin collections taken from the full set of coins: <var>Coins0</var>. <var>Coins1</var> is the full set of coins, updated with the inferences drawn from the weighing. <var>Counterfeit</var> is used to determine the result of the weighing. This predicate applies the critical insight into the solution of this puzzle: we have 24 (12 &times; 2) possible inputs to the procedure, with only 27 (3 &times; 3 &times; 3) possible outcomes from the weighings. Therefore, it is clear that each weighing must have a very high 'information content'. Choosing which weighing to make by estimating the available information content makes the problem tractable. <syntaxhighlight lang="prolog"> assay( Counterfeit, Coins0, Step, Branch, Coins ) :- WeighingDatum = weighing_data(InfoContent, Left, Right, Table), step( Step, Left, Right, Table, Branches ), findall( WeighingDatum, valid_partition( Coins0, InfoContent, Left, Right, Table ), WeighingData ), sort( WeighingData, OrderedWeighingData ), member( WeighingDatum, OrderedWeighingData ), balance( Left, Right, Counterfeit, Result ), draw_inferences( Result, Left, Right, Table, Coins ), branch( Result, Branches, Branch ). </syntaxhighlight> ====balance( +Left, +Right, +Counterfeit, ? Result )==== holds when <var>Result</var> simulates the outcome of testing the coin collections <var>Left</var> and <var>Right</var> with a balance, where either may contain the <var>Counterfeit</var> coin. <syntaxhighlight lang="prolog"> balance( Left, Right, Counterfeit, Result ):- counterfeit( Counterfeit, Coin, Weight ), ( contains_coin( Left, Coin ) -> balance_result( Weight, normal, Result ) ; contains_coin( Right, Coin ) -> balance_result( normal, Weight, Result ) ; otherwise -> Result = '=' ). balance_result( light, normal, < ). balance_result( heavy, normal, > ). balance_result( normal, heavy, < ). balance_result( normal, light, > ). </syntaxhighlight> ===Choosing which coins to weigh=== ====valid_partition( +Coins, ?Content, ?Left, ?Right, ?Table )==== holds when <var>Coins</var> can be partitioned into three collections: <var>Left</var> side, <var>Right</var> side and <var>Table</var>; with the 'information content' of the partition given by <var>Content</var>. The definition of a 'valid partition' ensures that: * <var>Left</var> and <var>Right</var> must have the same number of coins (at least one); * <var>Left</var> cannot contain any known 'true' coins, because adding true coins to both sides creates redundant comparisons. A 'checksum' is used to ensure that only one member of each pair of symmetrical solutions can be generated. <syntaxhighlight lang="prolog"> valid_partition( Coins, Content, Left, Right, Table ):- part( known_true, Left, [] ), selection( Coins, Left, Coins1, Count, LeftChecksum, LeftInfo ), Count >= 1, selection( Coins1, Right, Table, Count, RightChecksum, RightInfo ), LeftChecksum =< RightChecksum, % Checksum to prevent symmetrical solutions table_information( Table, TableInfo ), sum( [LeftInfo,RightInfo,TableInfo], Content ). </syntaxhighlight> ====selection( +Coins, ?Sample, ?Residue, ?Count, ?Checksum, ?Content )==== holds when <var>Coins</var> is partitioned into two collections: <var>Sample</var> and <var>Residue</var>. <var>Count</var> is the number of coins in <var>Sample</var>. <var>Checksum</var> is a fingerprint for the mixture of coins in <var>Sample</var>, which has 'information content' <var>Content</var>. <syntaxhighlight lang="prolog"> selection( Coins, Sample, Residue, Count, Checksum, Content ) :- select_coins( not_heavy, Coins, Sample, Residue, Count1 ), select_coins( not_light, Coins, Sample, Residue, Count2 ), select_coins( untested, Coins, Sample, Residue, Count3 ), select_coins( known_true, Coins, Sample, Residue, Count4 ), Count is Count1+Count2+Count3+Count4, Count =< 6, Checksum is Count1+(7*Count2)+(43*Count3)+(259*Count4), information_content( [Count1,Count2,Count3,Count4], Content ). table_information( Coins, Content ) :- count_coins( not_heavy, Coins, Count1 ), count_coins( not_light, Coins, Count2 ), count_coins( untested, Coins, Count3 ), count_coins( known_true, Coins, Count4 ), information_content( [Count1,Count2,Count3,Count4], Content ). count_coins( Part, Coins, Count ) :- part( Part, Coins, Selection ), length( Selection, Count ). </syntaxhighlight> === Updating what is known about the coins === ====draw_inferences( +Result, +Left, +Right, +Table, ?Coins )==== holds when <var>Result</var> is one of: * > (imbalance - left pan heavier), * < (imbalance - right pan heavier) or * <nowiki>=</nowiki> (pans balanced) from taking a weighing with the coin collections: <var>Left</var>, <var> Right</var> and <var>Table</var>. <var>Coins</var> is derived from this information using the following rules: * If the pans are unbalanced then only the previously untested or not_heavy coins on the lighter side of the balance are now not_heavy. Similarly, only the previously untested or not_light coins on the heavier side of the balance are now not_light. All the coins on the table are now known_true. * If the pans balance then all the coins weighed are known_true, with the coins on the <var>Table</var> left in their prior states. <syntaxhighlight lang="prolog"> draw_inferences( <, Left, Right, Table, Coins ) :- imbalance_inferences( Left, Right, Table, Coins ). draw_inferences( >, Left, Right, Table, Coins ) :- imbalance_inferences( Right, Left, Table, Coins ). draw_inferences( =, Left, Right, Table, Coins ) :- inference( [all(Left),known_true(Table),all(Right)], known_true( Coins ) ), inference( untested(Table), untested(Coins) ), inference( not_heavy(Table), not_heavy(Coins) ), inference( not_light(Table), not_light(Coins) ). </syntaxhighlight> ====imbalance_inferences( +Lighter, +Heavier, +Table, ?Coins )==== holds when: * All untested or not_heavy coins in <var>Lighter</var> are not_heavy in <var>Coins </var>; * All untested or not_light coins in <var>Heavier</var> are not_light in <var>Coins </var>; * All coins in <var>Table</var> are known_true in <var>Coins</var>; There are no untested coins in <var>Coins</var>. <syntaxhighlight lang="prolog"> imbalance_inferences( Lighter, Heavier, Table, Coins ) :- inference( [untested(Lighter),not_heavy(Lighter)], not_heavy(Coins) ), inference( [untested(Heavier),not_light(Heavier)], not_light(Coins) ), inference( [ known_true(Lighter), not_light(Lighter), known_true(Heavier), not_heavy(Heavier), all(Table) ], known_true(Coins) ), part( untested, Coins, [] ). </syntaxhighlight> ====inference( +CollectionA, ?CollectionB )==== holds when (part) <var>CollectionB</var> comprises the same coins as (part) <var>CollectionA</var>. <syntaxhighlight lang="prolog"> inference( CollectionA, CollectionB ) :- unfolded( CollectionA, Coins ), unfolded( CollectionB, Coins ). </syntaxhighlight> ====unfolded( +Collection, ?Coins )==== holds when (part) <var>Collection</var> comprises <var>Coins</var>. <syntaxhighlight lang="prolog"> unfolded( not_light(Collection), Coins ) :- part( not_light, Collection, Coins ). unfolded( not_heavy(Collection), Coins ) :- part( not_heavy, Collection, Coins ). unfolded( known_true(Collection), Coins ) :- part( known_true, Collection, Coins ). unfolded( untested(Collection), Coins ) :- part( untested, Collection, Coins ). unfolded( all(Collection), Coins ) :- collection_to_set( Collection, Coins ). unfolded( [Item|Items], Coins ) :- unfolded( Item, Value ), unfolded1( Items, Value, Coins ). unfolded1( [], Coins, Coins ). unfolded1( [Item|Items], Value, Coins ) :- unfolded( Item, Value0 ), ord_union( Value0, Value, Value1 ), unfolded1( Items, Value1, Coins ). </syntaxhighlight> ==Definite Clause Grammar== The following DCG represents the method for finding the counterfeit coin as a 'structured' procedure. <syntaxhighlight lang="prolog"> general_explanation( Procedure ) --> "Number the coins 1..12", newline, explanation( Procedure, 0 ). explanation( done(Coin, Weight), N ) --> tab( N ), "Conclude that the counterfeit coin is number ", literal( Coin ), ", which is ", literal( Weight ), newline. explanation( Step, N ) --> {step( Step, Left, Right, Table, Branches )}, tab( N ), "BEGIN", newline, tab( N ), "Put ", literal( Left ), " on the left-hand pan", newline, tab( N ), "Put ", literal( Right ), " on the right-hand pan", newline, tab( N ), "Leaving ", literal( Table ), " on the table", newline, branches_explained( Branches, N ), tab( N ), "END", newline. branches_explained( Branches, N ) --> next_step_explained( <, Branches, N ), next_step_explained( >, Branches, N ), next_step_explained( =, Branches, N ). next_step_explained( Result, Branch, N ) --> {branch( Result, Branch, Step )}, ( {var(Step)} -> "" | {nonvar(Step)} -> tab( N ), "If the ", literal( Result ), " then:", newline, explanation( Step, s(N) ) ). literal( 0 ) --> "0". literal( 1 ) --> "1". literal( 2 ) --> "2". literal( 3 ) --> "3". literal( 4 ) --> "4". literal( 5 ) --> "5". literal( 6 ) --> "6". literal( 7 ) --> "7". literal( 8 ) --> "8". literal( 9 ) --> "9". literal( 10 ) --> "10". literal( 11 ) --> "11". literal( 12 ) --> "12". literal( true ) --> "true". literal( heavy ) --> "heavy". literal( light ) --> "light". literal( = ) --> "pans balance". literal( < ) --> "right-hand pan is heavier". literal( > ) --> "left-hand pan is heavier". literal( Collection ) --> {collection_to_set( Collection , [H|T] )}, literal_set( T, H ). literal_set( [], Number ) --> "the coin numbered ", literal( Number ). literal_set( [H|T], Number ) --> "the coins numbered ", literal( Number ), literal_set1( T, H ). literal_set1( [], Number ) --> " and ", literal( Number ). literal_set1( [H|T], Number ) --> ", ", literal( Number ), literal_set1( T, H ). tab( 0 ) --> "". tab( s(N) ) --> " ", tab( N ). newline --> " ". </syntaxhighlight> ===Utility Predicates=== ====contains_coin( ?Collection, ?Coin )==== holds when <var>Coin</var> is a member of <var>Collection</var>. <syntaxhighlight lang="prolog"> contains_coin( Collection, Coin ) :- part( _Part, Collection, Coins ), member( Coin, Coins ). </syntaxhighlight> ====collection_to_set( +Collection, ?Set )==== holds when <var>Set</var> is the distributed union of the <code>known_true</code>, <code>not_heavy</code>, <code>not_light</code> and <code>untested</code> ordsets comprising <var>Collection</var>. <syntaxhighlight lang="prolog"> collection_to_set( Collection, Set ) :- part( known_true, Collection, KnownTrue ), part( not_heavy, Collection, NotHeavy ), part( not_light, Collection, NotLight ), part( untested, Collection, Untested ), ord_union( [KnownTrue,NotHeavy,NotLight,Untested], Set ). </syntaxhighlight> ==== information_content( +Counts, ?Content ) ==== holds when <var>Content</var> is the cumulative negative entropy of <var>Counts</var>. A reduction in entropy equates to a gain in information. <syntaxhighlight lang="prolog"> information_content( Counts, Content ) :- information_content1( Counts, 0, Content ). information_content1( [], Content, Content ). information_content1( [Count|Counts], Content0, Content ):- coins_entropy( Count, Entropy ), Content1 is Content0-Entropy, information_content1( Counts, Content1, Content ). </syntaxhighlight> ==== coins_entropy( ?N, ?Entropy ) ==== holds when <var>Entropy</var> estimates the entropy of a sample of <var>N</var> coins. <var>Entropy</var> = P log₂(1/P), where P = <var>N</var>/12. <syntaxhighlight lang="prolog"> coins_entropy( 0, 0.0 ). coins_entropy( 1, 0.2987 ). coins_entropy( 2, 0.4308 ). coins_entropy( 3, 0.5 ). coins_entropy( 4, 0.5283 ). coins_entropy( 5, 0.5263 ). coins_entropy( 6, 0.5 ). coins_entropy( 7, 0.4536 ). coins_entropy( 8, 0.39 ). coins_entropy( 9, 0.3113 ). coins_entropy( 10, 0.2192 ). coins_entropy( 11, 0.1151 ). coins_entropy( 12, 0.0 ). </syntaxhighlight> ====select_coins( +Part, +Coins, ?Sample, ?Residue, ?N )==== holds when <var>N</var> coins from <var>Part</var> of <var>Coins</var> form <var>Part</var> of <var>Sample</var>, with the remainder forming <var>Part</var> of <var>Residue</var>. <syntaxhighlight lang="prolog"> select_coins( Part, Coins, Sample, Residue, Count ) :- part( Part, Coins, Input ), part( Part, Sample, Selection ), part( Part, Residue, Remainder ), select_n( Count, Input, Selection, Remainder ). select_n( 0, In, [], In ). select_n( 1, [A|Suffix], [A], Suffix ). select_n( 2, [A,B|Suffix], [A,B], Suffix ). select_n( 3, [A,B,C|Suffix], [A,B,C], Suffix ). select_n( 4, [A,B,C,D|Suffix], [A,B,C,D], Suffix ). select_n( 5, [A,B,C,D,E|Suffix], [A,B,C,D,E], Suffix ). select_n( 6, [A,B,C,D,E,F|Suffix], [A,B,C,D,E,F], Suffix ). </syntaxhighlight> Load a small library of [https://binding-time.co.uk/misc.html puzzle utilities]. <syntaxhighlight lang="prolog"> :- ensure_loaded( misc ). </syntaxhighlight> Use the ordsets library. <syntaxhighlight lang="prolog"> :- use_module( library(ordsets), [ord_union/2,ord_union/3] ). </syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/counterfeit.txt here]. ==Output== <div class="result"> Number the coins 1..12 BEGIN Put the coins numbered 1, 2, 3 and 4 on the left-hand pan Put the coins numbered 5, 6, 7 and 8 on the right-hand pan Leaving the coins numbered 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 1, 2, 5 and 6 on the left-hand pan Put the coins numbered 3, 7, 9 and 10 on the right-hand pan Leaving the coins numbered 4, 8, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 1 and 7 on the left-hand pan Put the coins numbered 3 and 4 on the right-hand pan Leaving the coins numbered 2, 5, 6, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 1, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 7, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 2, which is light END If the left-hand pan is heavier then: BEGIN Put the coins numbered 3 and 5 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 4, 6, 7, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 3, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 5, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 6, which is heavy END If the pans balance then: BEGIN Put the coins numbered 4 and 8 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 3, 5, 6, 7, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 4, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 8, which is heavy END END If the left-hand pan is heavier then: BEGIN Put the coins numbered 1, 2, 5 and 6 on the left-hand pan Put the coins numbered 3, 7, 9 and 10 on the right-hand pan Leaving the coins numbered 4, 8, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 3 and 5 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 4, 6, 7, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 5, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 3, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 6, which is light END If the left-hand pan is heavier then: BEGIN Put the coins numbered 1 and 7 on the left-hand pan Put the coins numbered 3 and 4 on the right-hand pan Leaving the coins numbered 2, 5, 6, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 7, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 1, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 2, which is heavy END If the pans balance then: BEGIN Put the coins numbered 4 and 8 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 3, 5, 6, 7, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 8, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 4, which is heavy END END If the pans balance then: BEGIN Put the coins numbered 9, 10 and 11 on the left-hand pan Put the coins numbered 1, 2 and 3 on the right-hand pan Leaving the coins numbered 4, 5, 6, 7, 8 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coin numbered 9 on the left-hand pan Put the coin numbered 10 on the right-hand pan Leaving the coins numbered 1, 2, 3, 4, 5, 6, 7, 8, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 9, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 10, which is light If the pans balance then: Conclude that the counterfeit coin is number 11, which is light END If the left-hand pan is heavier then: BEGIN Put the coin numbered 9 on the left-hand pan Put the coin numbered 10 on the right-hand pan Leaving the coins numbered 1, 2, 3, 4, 5, 6, 7, 8, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 10, which is heavy If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 9, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 11, which is heavy END If the pans balance then: BEGIN Put the coin numbered 12 on the left-hand pan Put the coin numbered 1 on the right-hand pan Leaving the coins numbered 2, 3, 4, 5, 6, 7, 8, 9, 10 and 11 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 12, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 12, which is heavy END END END </div> ---- 9d7af078cb8e39402fe5603850bb45730c504b95 21 20 2013-07-22T23:28:21Z John 2 /* Definite Clause Grammar */ wikitext text/x-wiki __NOTOC__ ==Problem Definition== We are given 12 apparently identical coins - one of which is counterfeit. We know that the counterfeit has a different weight from the others, but we don't know if it's heavier or lighter. ===Task:=== Devise a procedure to identify any counterfeit coin using a balance to take up to three comparative weighings. ==Strategy== The information from three suitable weighings will make all but one of the 'coins', which are untested initially, 'known true'. There are three alternative deductions that make a coin 'known true': * if it is 'not heavy' and 'not light' - having been on both the comparatively lighter and heavier sides of imbalances; * if it was excluded from an imbalance; * if it was included in a balanced weighing. After three weighings there must be exactly one coin, the counterfeit, which is not 'true'. If the counterfeit is not true and 'not heavy' we deduce that it must be light. If it is not true and 'not light', it must be heavy. We use a 'generate-and-test' method as follows: * Create the set of all possible 'counterfeits': 12 coins &times; 2 weights ; * Devise a procedure that can identify the first counterfeit coin; * Show that the same procedure works for every other counterfeit. ==Entry Point== ====go==== is the entry point. It solves the puzzle, then uses a DCG to pretty-print the resulting procedure. <syntaxhighlight lang="prolog"> go :- coins_puzzle( Procedure ), phrase( general_explanation( Procedure ), Chars ), put_chars( Chars ). </syntaxhighlight> ====coins_puzzle( ?Procedure )==== generates the set of all possible 'counterfeits' and finds (or proves) that <var>Procedure</var> can identify them all. <syntaxhighlight lang="prolog"> coins_puzzle( Procedure ) :- coins( Coins ), counterfeit( Counterfeit, Coin, Weight ), findall( Counterfeit, (member(Coin,Coins), counterfeit_weight(Weight)), Counterfeits ), coins_puzzle_solution( Counterfeits, Procedure ). coins_puzzle_solution( [], _Procedure ). coins_puzzle_solution( [Counterfeit|Counterfeits], Procedure ) :- solve_coins( Counterfeit, Procedure ), coins_puzzle_solution( Counterfeits, Procedure ). </syntaxhighlight> A procedure is either 'done', identifying a particular coin and whether it is 'heavy' or 'light'; or it is a 'step'. A step defines the coins to be placed on the <var>Left</var> and <var>Right</var> pans, with the residue remaining on the <var>Table</var>, and three <var>Branches</var>, one of which will be chosen depending on the outcome of the weighing. <syntaxhighlight lang="prolog"> step( step(Left,Right,Table,Branches), Left, Right, Table, Branches). </syntaxhighlight> The <var>Branches</var> are three procedures equating to: * > (left pan heavier), * < (right pan heavier) and * <nowiki>= (pans balance).</nowiki> <syntaxhighlight lang="prolog"> branch( >, branches(_Equal, GT, _LT), GT ). branch( <, branches(_Equal, _GT, LT), LT ). branch( =, branches(Equal, _GT, _LT), Equal ). </syntaxhighlight> The counterfeit is defined by its number and whether it is heavy or light. <syntaxhighlight lang="prolog"> counterfeit( counterfeit(Coin, HeavyOrLight), Coin, HeavyOrLight ). coins( [1,2,3,4,5,6,7,8,9,10,11,12] ). counterfeit_weight( heavy ). counterfeit_weight( light ). </syntaxhighlight> A 'coin collection' comprises four 'parts' (subsets): the <code>known_true</code>, <code>not_heavy</code>, <code>not_light</code> and <code>untested</code> sets of coins. <syntaxhighlight lang="prolog"> part( known_true, collection(Coins,_,_,_), Coins ). part( not_heavy, collection(_,Coins,_,_), Coins ). part( not_light, collection(_,_,Coins,_), Coins ). part( untested, collection(_,_,_,Coins), Coins ). </syntaxhighlight> ==Solution== ====solve_coins( +Counterfeit, ?Procedure )==== holds when <var> Procedure</var> can correctly identify the <var>Counterfeit</var> coin. Beginning with a 'start' collection, in which all the coins are untested, the <var>Procedure</var> comprises three 'steps'. For each step a 'weighing' is made and a 'branch' is made in the <var>Procedure</var>, depending on the result of the weighing. After three steps, the <var>Procedure</var> must have reached the 'end' condition. Finally, an assertion (redundant test) ensures that the <var> Procedure</var> has found the correct end condition. <syntaxhighlight lang="prolog"> solve_coins( Counterfeit, Procedure ) :- start( Coins0 ), assay( Counterfeit, Coins0, Procedure, Branch1, Coins1 ), assay( Counterfeit, Coins1, Branch1, Branch2, Coins2 ), assay( Counterfeit, Coins2, Branch2, done(Coin, HeavyOrLight), Coins3 ), end( Coins3, Coin, HeavyOrLight ), counterfeit( Counterfeit, Coin, HeavyOrLight ). start( Coins ) :- coins( Untested ), part( untested, Coins, Untested ), part( not_heavy, Coins, [] ), part( not_light, Coins, [] ), part( known_true, Coins, [] ). end( Coins, Coin, HeavyOrLight ) :- part( untested, Coins, [] ), part( not_heavy, Coins, Light ), part( not_light, Coins, Heavy ), end_result( Heavy, Light, Coin, HeavyOrLight ). end_result( [Coin], [], Coin, heavy ). end_result( [], [Coin], Coin, light ). </syntaxhighlight> === Simulating the weighing process === ====assay( +Counterfeit, +Coins0, ?Step, ?Branch, ?Coins1 )==== holds when the appropriate <var>Branch</var> from <var>Step</var> is chosen by comparing the weights of two coin collections taken from the full set of coins: <var>Coins0</var>. <var>Coins1</var> is the full set of coins, updated with the inferences drawn from the weighing. <var>Counterfeit</var> is used to determine the result of the weighing. This predicate applies the critical insight into the solution of this puzzle: we have 24 (12 &times; 2) possible inputs to the procedure, with only 27 (3 &times; 3 &times; 3) possible outcomes from the weighings. Therefore, it is clear that each weighing must have a very high 'information content'. Choosing which weighing to make by estimating the available information content makes the problem tractable. <syntaxhighlight lang="prolog"> assay( Counterfeit, Coins0, Step, Branch, Coins ) :- WeighingDatum = weighing_data(InfoContent, Left, Right, Table), step( Step, Left, Right, Table, Branches ), findall( WeighingDatum, valid_partition( Coins0, InfoContent, Left, Right, Table ), WeighingData ), sort( WeighingData, OrderedWeighingData ), member( WeighingDatum, OrderedWeighingData ), balance( Left, Right, Counterfeit, Result ), draw_inferences( Result, Left, Right, Table, Coins ), branch( Result, Branches, Branch ). </syntaxhighlight> ====balance( +Left, +Right, +Counterfeit, ? Result )==== holds when <var>Result</var> simulates the outcome of testing the coin collections <var>Left</var> and <var>Right</var> with a balance, where either may contain the <var>Counterfeit</var> coin. <syntaxhighlight lang="prolog"> balance( Left, Right, Counterfeit, Result ):- counterfeit( Counterfeit, Coin, Weight ), ( contains_coin( Left, Coin ) -> balance_result( Weight, normal, Result ) ; contains_coin( Right, Coin ) -> balance_result( normal, Weight, Result ) ; otherwise -> Result = '=' ). balance_result( light, normal, < ). balance_result( heavy, normal, > ). balance_result( normal, heavy, < ). balance_result( normal, light, > ). </syntaxhighlight> ===Choosing which coins to weigh=== ====valid_partition( +Coins, ?Content, ?Left, ?Right, ?Table )==== holds when <var>Coins</var> can be partitioned into three collections: <var>Left</var> side, <var>Right</var> side and <var>Table</var>; with the 'information content' of the partition given by <var>Content</var>. The definition of a 'valid partition' ensures that: * <var>Left</var> and <var>Right</var> must have the same number of coins (at least one); * <var>Left</var> cannot contain any known 'true' coins, because adding true coins to both sides creates redundant comparisons. A 'checksum' is used to ensure that only one member of each pair of symmetrical solutions can be generated. <syntaxhighlight lang="prolog"> valid_partition( Coins, Content, Left, Right, Table ):- part( known_true, Left, [] ), selection( Coins, Left, Coins1, Count, LeftChecksum, LeftInfo ), Count >= 1, selection( Coins1, Right, Table, Count, RightChecksum, RightInfo ), LeftChecksum =< RightChecksum, % Checksum to prevent symmetrical solutions table_information( Table, TableInfo ), sum( [LeftInfo,RightInfo,TableInfo], Content ). </syntaxhighlight> ====selection( +Coins, ?Sample, ?Residue, ?Count, ?Checksum, ?Content )==== holds when <var>Coins</var> is partitioned into two collections: <var>Sample</var> and <var>Residue</var>. <var>Count</var> is the number of coins in <var>Sample</var>. <var>Checksum</var> is a fingerprint for the mixture of coins in <var>Sample</var>, which has 'information content' <var>Content</var>. <syntaxhighlight lang="prolog"> selection( Coins, Sample, Residue, Count, Checksum, Content ) :- select_coins( not_heavy, Coins, Sample, Residue, Count1 ), select_coins( not_light, Coins, Sample, Residue, Count2 ), select_coins( untested, Coins, Sample, Residue, Count3 ), select_coins( known_true, Coins, Sample, Residue, Count4 ), Count is Count1+Count2+Count3+Count4, Count =< 6, Checksum is Count1+(7*Count2)+(43*Count3)+(259*Count4), information_content( [Count1,Count2,Count3,Count4], Content ). table_information( Coins, Content ) :- count_coins( not_heavy, Coins, Count1 ), count_coins( not_light, Coins, Count2 ), count_coins( untested, Coins, Count3 ), count_coins( known_true, Coins, Count4 ), information_content( [Count1,Count2,Count3,Count4], Content ). count_coins( Part, Coins, Count ) :- part( Part, Coins, Selection ), length( Selection, Count ). </syntaxhighlight> === Updating what is known about the coins === ====draw_inferences( +Result, +Left, +Right, +Table, ?Coins )==== holds when <var>Result</var> is one of: * > (imbalance - left pan heavier), * < (imbalance - right pan heavier) or * <nowiki>=</nowiki> (pans balanced) from taking a weighing with the coin collections: <var>Left</var>, <var> Right</var> and <var>Table</var>. <var>Coins</var> is derived from this information using the following rules: * If the pans are unbalanced then only the previously untested or not_heavy coins on the lighter side of the balance are now not_heavy. Similarly, only the previously untested or not_light coins on the heavier side of the balance are now not_light. All the coins on the table are now known_true. * If the pans balance then all the coins weighed are known_true, with the coins on the <var>Table</var> left in their prior states. <syntaxhighlight lang="prolog"> draw_inferences( <, Left, Right, Table, Coins ) :- imbalance_inferences( Left, Right, Table, Coins ). draw_inferences( >, Left, Right, Table, Coins ) :- imbalance_inferences( Right, Left, Table, Coins ). draw_inferences( =, Left, Right, Table, Coins ) :- inference( [all(Left),known_true(Table),all(Right)], known_true( Coins ) ), inference( untested(Table), untested(Coins) ), inference( not_heavy(Table), not_heavy(Coins) ), inference( not_light(Table), not_light(Coins) ). </syntaxhighlight> ====imbalance_inferences( +Lighter, +Heavier, +Table, ?Coins )==== holds when: * All untested or not_heavy coins in <var>Lighter</var> are not_heavy in <var>Coins </var>; * All untested or not_light coins in <var>Heavier</var> are not_light in <var>Coins </var>; * All coins in <var>Table</var> are known_true in <var>Coins</var>; There are no untested coins in <var>Coins</var>. <syntaxhighlight lang="prolog"> imbalance_inferences( Lighter, Heavier, Table, Coins ) :- inference( [untested(Lighter),not_heavy(Lighter)], not_heavy(Coins) ), inference( [untested(Heavier),not_light(Heavier)], not_light(Coins) ), inference( [ known_true(Lighter), not_light(Lighter), known_true(Heavier), not_heavy(Heavier), all(Table) ], known_true(Coins) ), part( untested, Coins, [] ). </syntaxhighlight> ====inference( +CollectionA, ?CollectionB )==== holds when (part) <var>CollectionB</var> comprises the same coins as (part) <var>CollectionA</var>. <syntaxhighlight lang="prolog"> inference( CollectionA, CollectionB ) :- unfolded( CollectionA, Coins ), unfolded( CollectionB, Coins ). </syntaxhighlight> ====unfolded( +Collection, ?Coins )==== holds when (part) <var>Collection</var> comprises <var>Coins</var>. <syntaxhighlight lang="prolog"> unfolded( not_light(Collection), Coins ) :- part( not_light, Collection, Coins ). unfolded( not_heavy(Collection), Coins ) :- part( not_heavy, Collection, Coins ). unfolded( known_true(Collection), Coins ) :- part( known_true, Collection, Coins ). unfolded( untested(Collection), Coins ) :- part( untested, Collection, Coins ). unfolded( all(Collection), Coins ) :- collection_to_set( Collection, Coins ). unfolded( [Item|Items], Coins ) :- unfolded( Item, Value ), unfolded1( Items, Value, Coins ). unfolded1( [], Coins, Coins ). unfolded1( [Item|Items], Value, Coins ) :- unfolded( Item, Value0 ), ord_union( Value0, Value, Value1 ), unfolded1( Items, Value1, Coins ). </syntaxhighlight> ==Definite Clause Grammar== The following DCG represents the method for finding the counterfeit coin as a 'structured' procedure. <syntaxhighlight lang="prolog"> general_explanation( Procedure ) --> "Number the coins 1..12", newline, explanation( Procedure, 0 ). explanation( done(Coin, Weight), N ) --> tab( N ), "Conclude that the counterfeit coin is number ", literal( Coin ), ", which is ", literal( Weight ), newline. explanation( Step, N ) --> {step( Step, Left, Right, Table, Branches )}, tab( N ), "BEGIN", newline, tab( N ), "Put ", literal( Left ), " on the left-hand pan", newline, tab( N ), "Put ", literal( Right ), " on the right-hand pan", newline, tab( N ), "Leaving ", literal( Table ), " on the table", newline, branches_explained( Branches, N ), tab( N ), "END", newline. branches_explained( Branches, N ) --> next_step_explained( <, Branches, N ), next_step_explained( >, Branches, N ), next_step_explained( =, Branches, N ). next_step_explained( Result, Branch, N ) --> {branch( Result, Branch, Step )}, ( {var(Step)} -> "" | {nonvar(Step)} -> tab( N ), "If the ", literal( Result ), " then:", newline, explanation( Step, s(N) ) ). literal( 0 ) --> "0". literal( 1 ) --> "1". literal( 2 ) --> "2". literal( 3 ) --> "3". literal( 4 ) --> "4". literal( 5 ) --> "5". literal( 6 ) --> "6". literal( 7 ) --> "7". literal( 8 ) --> "8". literal( 9 ) --> "9". literal( 10 ) --> "10". literal( 11 ) --> "11". literal( 12 ) --> "12". literal( true ) --> "true". literal( heavy ) --> "heavy". literal( light ) --> "light". literal( = ) --> "pans balance". literal( < ) --> "right-hand pan is heavier". literal( > ) --> "left-hand pan is heavier". literal( Collection ) --> {collection_to_set( Collection , [H|T] )}, literal_set( T, H ). literal_set( [], Number ) --> "the coin numbered ", literal( Number ). literal_set( [H|T], Number ) --> "the coins numbered ", literal( Number ), literal_set1( T, H ). literal_set1( [], Number ) --> " and ", literal( Number ). literal_set1( [H|T], Number ) --> ", ", literal( Number ), literal_set1( T, H ). tab( 0 ) --> "". tab( s(N) ) --> " ", tab( N ). newline --> " ". </syntaxhighlight> ===Utility Predicates=== ====contains_coin( ?Collection, ?Coin )==== holds when <var>Coin</var> is a member of <var>Collection</var>. <syntaxhighlight lang="prolog"> contains_coin( Collection, Coin ) :- part( _Part, Collection, Coins ), member( Coin, Coins ). </syntaxhighlight> ====collection_to_set( +Collection, ?Set )==== holds when <var>Set</var> is the distributed union of the <code>known_true</code>, <code>not_heavy</code>, <code>not_light</code> and <code>untested</code> ordsets comprising <var>Collection</var>. <syntaxhighlight lang="prolog"> collection_to_set( Collection, Set ) :- part( known_true, Collection, KnownTrue ), part( not_heavy, Collection, NotHeavy ), part( not_light, Collection, NotLight ), part( untested, Collection, Untested ), ord_union( [KnownTrue,NotHeavy,NotLight,Untested], Set ). </syntaxhighlight> ==== information_content( +Counts, ?Content ) ==== holds when <var>Content</var> is the cumulative negative entropy of <var>Counts</var>. A reduction in entropy equates to a gain in information. <syntaxhighlight lang="prolog"> information_content( Counts, Content ) :- information_content1( Counts, 0, Content ). information_content1( [], Content, Content ). information_content1( [Count|Counts], Content0, Content ):- coins_entropy( Count, Entropy ), Content1 is Content0-Entropy, information_content1( Counts, Content1, Content ). </syntaxhighlight> ==== coins_entropy( ?N, ?Entropy ) ==== holds when <var>Entropy</var> estimates the entropy of a sample of <var>N</var> coins. <var>Entropy</var> = P log₂(1/P), where P = <var>N</var>/12. <syntaxhighlight lang="prolog"> coins_entropy( 0, 0.0 ). coins_entropy( 1, 0.2987 ). coins_entropy( 2, 0.4308 ). coins_entropy( 3, 0.5 ). coins_entropy( 4, 0.5283 ). coins_entropy( 5, 0.5263 ). coins_entropy( 6, 0.5 ). coins_entropy( 7, 0.4536 ). coins_entropy( 8, 0.39 ). coins_entropy( 9, 0.3113 ). coins_entropy( 10, 0.2192 ). coins_entropy( 11, 0.1151 ). coins_entropy( 12, 0.0 ). </syntaxhighlight> ====select_coins( +Part, +Coins, ?Sample, ?Residue, ?N )==== holds when <var>N</var> coins from <var>Part</var> of <var>Coins</var> form <var>Part</var> of <var>Sample</var>, with the remainder forming <var>Part</var> of <var>Residue</var>. <syntaxhighlight lang="prolog"> select_coins( Part, Coins, Sample, Residue, Count ) :- part( Part, Coins, Input ), part( Part, Sample, Selection ), part( Part, Residue, Remainder ), select_n( Count, Input, Selection, Remainder ). select_n( 0, In, [], In ). select_n( 1, [A|Suffix], [A], Suffix ). select_n( 2, [A,B|Suffix], [A,B], Suffix ). select_n( 3, [A,B,C|Suffix], [A,B,C], Suffix ). select_n( 4, [A,B,C,D|Suffix], [A,B,C,D], Suffix ). select_n( 5, [A,B,C,D,E|Suffix], [A,B,C,D,E], Suffix ). select_n( 6, [A,B,C,D,E,F|Suffix], [A,B,C,D,E,F], Suffix ). </syntaxhighlight> Load a small library of [https://binding-time.co.uk/misc.html puzzle utilities]. <syntaxhighlight lang="prolog"> :- ensure_loaded( misc ). </syntaxhighlight> Use the ordsets library. <syntaxhighlight lang="prolog"> :- use_module( library(ordsets), [ord_union/2,ord_union/3] ). </syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/counterfeit.txt here]. ==Output== <div class="result"> Number the coins 1..12 BEGIN Put the coins numbered 1, 2, 3 and 4 on the left-hand pan Put the coins numbered 5, 6, 7 and 8 on the right-hand pan Leaving the coins numbered 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 1, 2, 5 and 6 on the left-hand pan Put the coins numbered 3, 7, 9 and 10 on the right-hand pan Leaving the coins numbered 4, 8, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 1 and 7 on the left-hand pan Put the coins numbered 3 and 4 on the right-hand pan Leaving the coins numbered 2, 5, 6, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 1, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 7, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 2, which is light END If the left-hand pan is heavier then: BEGIN Put the coins numbered 3 and 5 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 4, 6, 7, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 3, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 5, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 6, which is heavy END If the pans balance then: BEGIN Put the coins numbered 4 and 8 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 3, 5, 6, 7, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 4, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 8, which is heavy END END If the left-hand pan is heavier then: BEGIN Put the coins numbered 1, 2, 5 and 6 on the left-hand pan Put the coins numbered 3, 7, 9 and 10 on the right-hand pan Leaving the coins numbered 4, 8, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 3 and 5 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 4, 6, 7, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 5, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 3, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 6, which is light END If the left-hand pan is heavier then: BEGIN Put the coins numbered 1 and 7 on the left-hand pan Put the coins numbered 3 and 4 on the right-hand pan Leaving the coins numbered 2, 5, 6, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 7, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 1, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 2, which is heavy END If the pans balance then: BEGIN Put the coins numbered 4 and 8 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 3, 5, 6, 7, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 8, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 4, which is heavy END END If the pans balance then: BEGIN Put the coins numbered 9, 10 and 11 on the left-hand pan Put the coins numbered 1, 2 and 3 on the right-hand pan Leaving the coins numbered 4, 5, 6, 7, 8 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coin numbered 9 on the left-hand pan Put the coin numbered 10 on the right-hand pan Leaving the coins numbered 1, 2, 3, 4, 5, 6, 7, 8, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 9, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 10, which is light If the pans balance then: Conclude that the counterfeit coin is number 11, which is light END If the left-hand pan is heavier then: BEGIN Put the coin numbered 9 on the left-hand pan Put the coin numbered 10 on the right-hand pan Leaving the coins numbered 1, 2, 3, 4, 5, 6, 7, 8, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 10, which is heavy If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 9, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 11, which is heavy END If the pans balance then: BEGIN Put the coin numbered 12 on the left-hand pan Put the coin numbered 1 on the right-hand pan Leaving the coins numbered 2, 3, 4, 5, 6, 7, 8, 9, 10 and 11 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 12, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 12, which is heavy END END END </div> ---- a4f474f05a1db6bd1892d06e7ea8f84e8daa2613 22 21 2013-07-23T21:50:24Z John 2 /* balance( +Left, +Right, +Counterfeit, ? Result ) */ wikitext text/x-wiki __NOTOC__ ==Problem Definition== We are given 12 apparently identical coins - one of which is counterfeit. We know that the counterfeit has a different weight from the others, but we don't know if it's heavier or lighter. ===Task:=== Devise a procedure to identify any counterfeit coin using a balance to take up to three comparative weighings. ==Strategy== The information from three suitable weighings will make all but one of the 'coins', which are untested initially, 'known true'. There are three alternative deductions that make a coin 'known true': * if it is 'not heavy' and 'not light' - having been on both the comparatively lighter and heavier sides of imbalances; * if it was excluded from an imbalance; * if it was included in a balanced weighing. After three weighings there must be exactly one coin, the counterfeit, which is not 'true'. If the counterfeit is not true and 'not heavy' we deduce that it must be light. If it is not true and 'not light', it must be heavy. We use a 'generate-and-test' method as follows: * Create the set of all possible 'counterfeits': 12 coins &times; 2 weights ; * Devise a procedure that can identify the first counterfeit coin; * Show that the same procedure works for every other counterfeit. ==Entry Point== ====go==== is the entry point. It solves the puzzle, then uses a DCG to pretty-print the resulting procedure. <syntaxhighlight lang="prolog"> go :- coins_puzzle( Procedure ), phrase( general_explanation( Procedure ), Chars ), put_chars( Chars ). </syntaxhighlight> ====coins_puzzle( ?Procedure )==== generates the set of all possible 'counterfeits' and finds (or proves) that <var>Procedure</var> can identify them all. <syntaxhighlight lang="prolog"> coins_puzzle( Procedure ) :- coins( Coins ), counterfeit( Counterfeit, Coin, Weight ), findall( Counterfeit, (member(Coin,Coins), counterfeit_weight(Weight)), Counterfeits ), coins_puzzle_solution( Counterfeits, Procedure ). coins_puzzle_solution( [], _Procedure ). coins_puzzle_solution( [Counterfeit|Counterfeits], Procedure ) :- solve_coins( Counterfeit, Procedure ), coins_puzzle_solution( Counterfeits, Procedure ). </syntaxhighlight> A procedure is either 'done', identifying a particular coin and whether it is 'heavy' or 'light'; or it is a 'step'. A step defines the coins to be placed on the <var>Left</var> and <var>Right</var> pans, with the residue remaining on the <var>Table</var>, and three <var>Branches</var>, one of which will be chosen depending on the outcome of the weighing. <syntaxhighlight lang="prolog"> step( step(Left,Right,Table,Branches), Left, Right, Table, Branches). </syntaxhighlight> The <var>Branches</var> are three procedures equating to: * > (left pan heavier), * < (right pan heavier) and * <nowiki>= (pans balance).</nowiki> <syntaxhighlight lang="prolog"> branch( >, branches(_Equal, GT, _LT), GT ). branch( <, branches(_Equal, _GT, LT), LT ). branch( =, branches(Equal, _GT, _LT), Equal ). </syntaxhighlight> The counterfeit is defined by its number and whether it is heavy or light. <syntaxhighlight lang="prolog"> counterfeit( counterfeit(Coin, HeavyOrLight), Coin, HeavyOrLight ). coins( [1,2,3,4,5,6,7,8,9,10,11,12] ). counterfeit_weight( heavy ). counterfeit_weight( light ). </syntaxhighlight> A 'coin collection' comprises four 'parts' (subsets): the <code>known_true</code>, <code>not_heavy</code>, <code>not_light</code> and <code>untested</code> sets of coins. <syntaxhighlight lang="prolog"> part( known_true, collection(Coins,_,_,_), Coins ). part( not_heavy, collection(_,Coins,_,_), Coins ). part( not_light, collection(_,_,Coins,_), Coins ). part( untested, collection(_,_,_,Coins), Coins ). </syntaxhighlight> ==Solution== ====solve_coins( +Counterfeit, ?Procedure )==== holds when <var> Procedure</var> can correctly identify the <var>Counterfeit</var> coin. Beginning with a 'start' collection, in which all the coins are untested, the <var>Procedure</var> comprises three 'steps'. For each step a 'weighing' is made and a 'branch' is made in the <var>Procedure</var>, depending on the result of the weighing. After three steps, the <var>Procedure</var> must have reached the 'end' condition. Finally, an assertion (redundant test) ensures that the <var> Procedure</var> has found the correct end condition. <syntaxhighlight lang="prolog"> solve_coins( Counterfeit, Procedure ) :- start( Coins0 ), assay( Counterfeit, Coins0, Procedure, Branch1, Coins1 ), assay( Counterfeit, Coins1, Branch1, Branch2, Coins2 ), assay( Counterfeit, Coins2, Branch2, done(Coin, HeavyOrLight), Coins3 ), end( Coins3, Coin, HeavyOrLight ), counterfeit( Counterfeit, Coin, HeavyOrLight ). start( Coins ) :- coins( Untested ), part( untested, Coins, Untested ), part( not_heavy, Coins, [] ), part( not_light, Coins, [] ), part( known_true, Coins, [] ). end( Coins, Coin, HeavyOrLight ) :- part( untested, Coins, [] ), part( not_heavy, Coins, Light ), part( not_light, Coins, Heavy ), end_result( Heavy, Light, Coin, HeavyOrLight ). end_result( [Coin], [], Coin, heavy ). end_result( [], [Coin], Coin, light ). </syntaxhighlight> === Simulating the weighing process === ====assay( +Counterfeit, +Coins0, ?Step, ?Branch, ?Coins1 )==== holds when the appropriate <var>Branch</var> from <var>Step</var> is chosen by comparing the weights of two coin collections taken from the full set of coins: <var>Coins0</var>. <var>Coins1</var> is the full set of coins, updated with the inferences drawn from the weighing. <var>Counterfeit</var> is used to determine the result of the weighing. This predicate applies the critical insight into the solution of this puzzle: we have 24 (12 &times; 2) possible inputs to the procedure, with only 27 (3 &times; 3 &times; 3) possible outcomes from the weighings. Therefore, it is clear that each weighing must have a very high 'information content'. Choosing which weighing to make by estimating the available information content makes the problem tractable. <syntaxhighlight lang="prolog"> assay( Counterfeit, Coins0, Step, Branch, Coins ) :- WeighingDatum = weighing_data(InfoContent, Left, Right, Table), step( Step, Left, Right, Table, Branches ), findall( WeighingDatum, valid_partition( Coins0, InfoContent, Left, Right, Table ), WeighingData ), sort( WeighingData, OrderedWeighingData ), member( WeighingDatum, OrderedWeighingData ), balance( Left, Right, Counterfeit, Result ), draw_inferences( Result, Left, Right, Table, Coins ), branch( Result, Branches, Branch ). </syntaxhighlight> ====balance( +Left, +Right, +Counterfeit, ?Result )==== holds when <var>Result</var> simulates the outcome of testing the coin collections <var>Left</var> and <var>Right</var> with a balance, where either may contain the <var>Counterfeit</var> coin. <syntaxhighlight lang="prolog"> balance( Left, Right, Counterfeit, Result ):- counterfeit( Counterfeit, Coin, Weight ), ( contains_coin( Left, Coin ) -> balance_result( Weight, normal, Result ) ; contains_coin( Right, Coin ) -> balance_result( normal, Weight, Result ) ; otherwise -> Result = '=' ). balance_result( light, normal, < ). balance_result( heavy, normal, > ). balance_result( normal, heavy, < ). balance_result( normal, light, > ). </syntaxhighlight> ===Choosing which coins to weigh=== ====valid_partition( +Coins, ?Content, ?Left, ?Right, ?Table )==== holds when <var>Coins</var> can be partitioned into three collections: <var>Left</var> side, <var>Right</var> side and <var>Table</var>; with the 'information content' of the partition given by <var>Content</var>. The definition of a 'valid partition' ensures that: * <var>Left</var> and <var>Right</var> must have the same number of coins (at least one); * <var>Left</var> cannot contain any known 'true' coins, because adding true coins to both sides creates redundant comparisons. A 'checksum' is used to ensure that only one member of each pair of symmetrical solutions can be generated. <syntaxhighlight lang="prolog"> valid_partition( Coins, Content, Left, Right, Table ):- part( known_true, Left, [] ), selection( Coins, Left, Coins1, Count, LeftChecksum, LeftInfo ), Count >= 1, selection( Coins1, Right, Table, Count, RightChecksum, RightInfo ), LeftChecksum =< RightChecksum, % Checksum to prevent symmetrical solutions table_information( Table, TableInfo ), sum( [LeftInfo,RightInfo,TableInfo], Content ). </syntaxhighlight> ====selection( +Coins, ?Sample, ?Residue, ?Count, ?Checksum, ?Content )==== holds when <var>Coins</var> is partitioned into two collections: <var>Sample</var> and <var>Residue</var>. <var>Count</var> is the number of coins in <var>Sample</var>. <var>Checksum</var> is a fingerprint for the mixture of coins in <var>Sample</var>, which has 'information content' <var>Content</var>. <syntaxhighlight lang="prolog"> selection( Coins, Sample, Residue, Count, Checksum, Content ) :- select_coins( not_heavy, Coins, Sample, Residue, Count1 ), select_coins( not_light, Coins, Sample, Residue, Count2 ), select_coins( untested, Coins, Sample, Residue, Count3 ), select_coins( known_true, Coins, Sample, Residue, Count4 ), Count is Count1+Count2+Count3+Count4, Count =< 6, Checksum is Count1+(7*Count2)+(43*Count3)+(259*Count4), information_content( [Count1,Count2,Count3,Count4], Content ). table_information( Coins, Content ) :- count_coins( not_heavy, Coins, Count1 ), count_coins( not_light, Coins, Count2 ), count_coins( untested, Coins, Count3 ), count_coins( known_true, Coins, Count4 ), information_content( [Count1,Count2,Count3,Count4], Content ). count_coins( Part, Coins, Count ) :- part( Part, Coins, Selection ), length( Selection, Count ). </syntaxhighlight> === Updating what is known about the coins === ====draw_inferences( +Result, +Left, +Right, +Table, ?Coins )==== holds when <var>Result</var> is one of: * > (imbalance - left pan heavier), * < (imbalance - right pan heavier) or * <nowiki>=</nowiki> (pans balanced) from taking a weighing with the coin collections: <var>Left</var>, <var> Right</var> and <var>Table</var>. <var>Coins</var> is derived from this information using the following rules: * If the pans are unbalanced then only the previously untested or not_heavy coins on the lighter side of the balance are now not_heavy. Similarly, only the previously untested or not_light coins on the heavier side of the balance are now not_light. All the coins on the table are now known_true. * If the pans balance then all the coins weighed are known_true, with the coins on the <var>Table</var> left in their prior states. <syntaxhighlight lang="prolog"> draw_inferences( <, Left, Right, Table, Coins ) :- imbalance_inferences( Left, Right, Table, Coins ). draw_inferences( >, Left, Right, Table, Coins ) :- imbalance_inferences( Right, Left, Table, Coins ). draw_inferences( =, Left, Right, Table, Coins ) :- inference( [all(Left),known_true(Table),all(Right)], known_true( Coins ) ), inference( untested(Table), untested(Coins) ), inference( not_heavy(Table), not_heavy(Coins) ), inference( not_light(Table), not_light(Coins) ). </syntaxhighlight> ====imbalance_inferences( +Lighter, +Heavier, +Table, ?Coins )==== holds when: * All untested or not_heavy coins in <var>Lighter</var> are not_heavy in <var>Coins </var>; * All untested or not_light coins in <var>Heavier</var> are not_light in <var>Coins </var>; * All coins in <var>Table</var> are known_true in <var>Coins</var>; There are no untested coins in <var>Coins</var>. <syntaxhighlight lang="prolog"> imbalance_inferences( Lighter, Heavier, Table, Coins ) :- inference( [untested(Lighter),not_heavy(Lighter)], not_heavy(Coins) ), inference( [untested(Heavier),not_light(Heavier)], not_light(Coins) ), inference( [ known_true(Lighter), not_light(Lighter), known_true(Heavier), not_heavy(Heavier), all(Table) ], known_true(Coins) ), part( untested, Coins, [] ). </syntaxhighlight> ====inference( +CollectionA, ?CollectionB )==== holds when (part) <var>CollectionB</var> comprises the same coins as (part) <var>CollectionA</var>. <syntaxhighlight lang="prolog"> inference( CollectionA, CollectionB ) :- unfolded( CollectionA, Coins ), unfolded( CollectionB, Coins ). </syntaxhighlight> ====unfolded( +Collection, ?Coins )==== holds when (part) <var>Collection</var> comprises <var>Coins</var>. <syntaxhighlight lang="prolog"> unfolded( not_light(Collection), Coins ) :- part( not_light, Collection, Coins ). unfolded( not_heavy(Collection), Coins ) :- part( not_heavy, Collection, Coins ). unfolded( known_true(Collection), Coins ) :- part( known_true, Collection, Coins ). unfolded( untested(Collection), Coins ) :- part( untested, Collection, Coins ). unfolded( all(Collection), Coins ) :- collection_to_set( Collection, Coins ). unfolded( [Item|Items], Coins ) :- unfolded( Item, Value ), unfolded1( Items, Value, Coins ). unfolded1( [], Coins, Coins ). unfolded1( [Item|Items], Value, Coins ) :- unfolded( Item, Value0 ), ord_union( Value0, Value, Value1 ), unfolded1( Items, Value1, Coins ). </syntaxhighlight> ==Definite Clause Grammar== The following DCG represents the method for finding the counterfeit coin as a 'structured' procedure. <syntaxhighlight lang="prolog"> general_explanation( Procedure ) --> "Number the coins 1..12", newline, explanation( Procedure, 0 ). explanation( done(Coin, Weight), N ) --> tab( N ), "Conclude that the counterfeit coin is number ", literal( Coin ), ", which is ", literal( Weight ), newline. explanation( Step, N ) --> {step( Step, Left, Right, Table, Branches )}, tab( N ), "BEGIN", newline, tab( N ), "Put ", literal( Left ), " on the left-hand pan", newline, tab( N ), "Put ", literal( Right ), " on the right-hand pan", newline, tab( N ), "Leaving ", literal( Table ), " on the table", newline, branches_explained( Branches, N ), tab( N ), "END", newline. branches_explained( Branches, N ) --> next_step_explained( <, Branches, N ), next_step_explained( >, Branches, N ), next_step_explained( =, Branches, N ). next_step_explained( Result, Branch, N ) --> {branch( Result, Branch, Step )}, ( {var(Step)} -> "" | {nonvar(Step)} -> tab( N ), "If the ", literal( Result ), " then:", newline, explanation( Step, s(N) ) ). literal( 0 ) --> "0". literal( 1 ) --> "1". literal( 2 ) --> "2". literal( 3 ) --> "3". literal( 4 ) --> "4". literal( 5 ) --> "5". literal( 6 ) --> "6". literal( 7 ) --> "7". literal( 8 ) --> "8". literal( 9 ) --> "9". literal( 10 ) --> "10". literal( 11 ) --> "11". literal( 12 ) --> "12". literal( true ) --> "true". literal( heavy ) --> "heavy". literal( light ) --> "light". literal( = ) --> "pans balance". literal( < ) --> "right-hand pan is heavier". literal( > ) --> "left-hand pan is heavier". literal( Collection ) --> {collection_to_set( Collection , [H|T] )}, literal_set( T, H ). literal_set( [], Number ) --> "the coin numbered ", literal( Number ). literal_set( [H|T], Number ) --> "the coins numbered ", literal( Number ), literal_set1( T, H ). literal_set1( [], Number ) --> " and ", literal( Number ). literal_set1( [H|T], Number ) --> ", ", literal( Number ), literal_set1( T, H ). tab( 0 ) --> "". tab( s(N) ) --> " ", tab( N ). newline --> " ". </syntaxhighlight> ===Utility Predicates=== ====contains_coin( ?Collection, ?Coin )==== holds when <var>Coin</var> is a member of <var>Collection</var>. <syntaxhighlight lang="prolog"> contains_coin( Collection, Coin ) :- part( _Part, Collection, Coins ), member( Coin, Coins ). </syntaxhighlight> ====collection_to_set( +Collection, ?Set )==== holds when <var>Set</var> is the distributed union of the <code>known_true</code>, <code>not_heavy</code>, <code>not_light</code> and <code>untested</code> ordsets comprising <var>Collection</var>. <syntaxhighlight lang="prolog"> collection_to_set( Collection, Set ) :- part( known_true, Collection, KnownTrue ), part( not_heavy, Collection, NotHeavy ), part( not_light, Collection, NotLight ), part( untested, Collection, Untested ), ord_union( [KnownTrue,NotHeavy,NotLight,Untested], Set ). </syntaxhighlight> ==== information_content( +Counts, ?Content ) ==== holds when <var>Content</var> is the cumulative negative entropy of <var>Counts</var>. A reduction in entropy equates to a gain in information. <syntaxhighlight lang="prolog"> information_content( Counts, Content ) :- information_content1( Counts, 0, Content ). information_content1( [], Content, Content ). information_content1( [Count|Counts], Content0, Content ):- coins_entropy( Count, Entropy ), Content1 is Content0-Entropy, information_content1( Counts, Content1, Content ). </syntaxhighlight> ==== coins_entropy( ?N, ?Entropy ) ==== holds when <var>Entropy</var> estimates the entropy of a sample of <var>N</var> coins. <var>Entropy</var> = P log₂(1/P), where P = <var>N</var>/12. <syntaxhighlight lang="prolog"> coins_entropy( 0, 0.0 ). coins_entropy( 1, 0.2987 ). coins_entropy( 2, 0.4308 ). coins_entropy( 3, 0.5 ). coins_entropy( 4, 0.5283 ). coins_entropy( 5, 0.5263 ). coins_entropy( 6, 0.5 ). coins_entropy( 7, 0.4536 ). coins_entropy( 8, 0.39 ). coins_entropy( 9, 0.3113 ). coins_entropy( 10, 0.2192 ). coins_entropy( 11, 0.1151 ). coins_entropy( 12, 0.0 ). </syntaxhighlight> ====select_coins( +Part, +Coins, ?Sample, ?Residue, ?N )==== holds when <var>N</var> coins from <var>Part</var> of <var>Coins</var> form <var>Part</var> of <var>Sample</var>, with the remainder forming <var>Part</var> of <var>Residue</var>. <syntaxhighlight lang="prolog"> select_coins( Part, Coins, Sample, Residue, Count ) :- part( Part, Coins, Input ), part( Part, Sample, Selection ), part( Part, Residue, Remainder ), select_n( Count, Input, Selection, Remainder ). select_n( 0, In, [], In ). select_n( 1, [A|Suffix], [A], Suffix ). select_n( 2, [A,B|Suffix], [A,B], Suffix ). select_n( 3, [A,B,C|Suffix], [A,B,C], Suffix ). select_n( 4, [A,B,C,D|Suffix], [A,B,C,D], Suffix ). select_n( 5, [A,B,C,D,E|Suffix], [A,B,C,D,E], Suffix ). select_n( 6, [A,B,C,D,E,F|Suffix], [A,B,C,D,E,F], Suffix ). </syntaxhighlight> Load a small library of [https://binding-time.co.uk/misc.html puzzle utilities]. <syntaxhighlight lang="prolog"> :- ensure_loaded( misc ). </syntaxhighlight> Use the ordsets library. <syntaxhighlight lang="prolog"> :- use_module( library(ordsets), [ord_union/2,ord_union/3] ). </syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/counterfeit.txt here]. ==Output== <div class="result"> Number the coins 1..12 BEGIN Put the coins numbered 1, 2, 3 and 4 on the left-hand pan Put the coins numbered 5, 6, 7 and 8 on the right-hand pan Leaving the coins numbered 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 1, 2, 5 and 6 on the left-hand pan Put the coins numbered 3, 7, 9 and 10 on the right-hand pan Leaving the coins numbered 4, 8, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 1 and 7 on the left-hand pan Put the coins numbered 3 and 4 on the right-hand pan Leaving the coins numbered 2, 5, 6, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 1, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 7, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 2, which is light END If the left-hand pan is heavier then: BEGIN Put the coins numbered 3 and 5 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 4, 6, 7, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 3, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 5, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 6, which is heavy END If the pans balance then: BEGIN Put the coins numbered 4 and 8 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 3, 5, 6, 7, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 4, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 8, which is heavy END END If the left-hand pan is heavier then: BEGIN Put the coins numbered 1, 2, 5 and 6 on the left-hand pan Put the coins numbered 3, 7, 9 and 10 on the right-hand pan Leaving the coins numbered 4, 8, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 3 and 5 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 4, 6, 7, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 5, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 3, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 6, which is light END If the left-hand pan is heavier then: BEGIN Put the coins numbered 1 and 7 on the left-hand pan Put the coins numbered 3 and 4 on the right-hand pan Leaving the coins numbered 2, 5, 6, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 7, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 1, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 2, which is heavy END If the pans balance then: BEGIN Put the coins numbered 4 and 8 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 3, 5, 6, 7, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 8, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 4, which is heavy END END If the pans balance then: BEGIN Put the coins numbered 9, 10 and 11 on the left-hand pan Put the coins numbered 1, 2 and 3 on the right-hand pan Leaving the coins numbered 4, 5, 6, 7, 8 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coin numbered 9 on the left-hand pan Put the coin numbered 10 on the right-hand pan Leaving the coins numbered 1, 2, 3, 4, 5, 6, 7, 8, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 9, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 10, which is light If the pans balance then: Conclude that the counterfeit coin is number 11, which is light END If the left-hand pan is heavier then: BEGIN Put the coin numbered 9 on the left-hand pan Put the coin numbered 10 on the right-hand pan Leaving the coins numbered 1, 2, 3, 4, 5, 6, 7, 8, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 10, which is heavy If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 9, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 11, which is heavy END If the pans balance then: BEGIN Put the coin numbered 12 on the left-hand pan Put the coin numbered 1 on the right-hand pan Leaving the coins numbered 2, 3, 4, 5, 6, 7, 8, 9, 10 and 11 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 12, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 12, which is heavy END END END </div> ---- a82563cc58298c008f9953ab68b1320bce29e3fc 23 22 2013-08-09T23:05:45Z John 2 /* selection( +Coins, ?Sample, ?Residue, ?Count, ?Checksum, ?Content ) */ wikitext text/x-wiki __NOTOC__ ==Problem Definition== We are given 12 apparently identical coins - one of which is counterfeit. We know that the counterfeit has a different weight from the others, but we don't know if it's heavier or lighter. ===Task:=== Devise a procedure to identify any counterfeit coin using a balance to take up to three comparative weighings. ==Strategy== The information from three suitable weighings will make all but one of the 'coins', which are untested initially, 'known true'. There are three alternative deductions that make a coin 'known true': * if it is 'not heavy' and 'not light' - having been on both the comparatively lighter and heavier sides of imbalances; * if it was excluded from an imbalance; * if it was included in a balanced weighing. After three weighings there must be exactly one coin, the counterfeit, which is not 'true'. If the counterfeit is not true and 'not heavy' we deduce that it must be light. If it is not true and 'not light', it must be heavy. We use a 'generate-and-test' method as follows: * Create the set of all possible 'counterfeits': 12 coins &times; 2 weights ; * Devise a procedure that can identify the first counterfeit coin; * Show that the same procedure works for every other counterfeit. ==Entry Point== ====go==== is the entry point. It solves the puzzle, then uses a DCG to pretty-print the resulting procedure. <syntaxhighlight lang="prolog"> go :- coins_puzzle( Procedure ), phrase( general_explanation( Procedure ), Chars ), put_chars( Chars ). </syntaxhighlight> ====coins_puzzle( ?Procedure )==== generates the set of all possible 'counterfeits' and finds (or proves) that <var>Procedure</var> can identify them all. <syntaxhighlight lang="prolog"> coins_puzzle( Procedure ) :- coins( Coins ), counterfeit( Counterfeit, Coin, Weight ), findall( Counterfeit, (member(Coin,Coins), counterfeit_weight(Weight)), Counterfeits ), coins_puzzle_solution( Counterfeits, Procedure ). coins_puzzle_solution( [], _Procedure ). coins_puzzle_solution( [Counterfeit|Counterfeits], Procedure ) :- solve_coins( Counterfeit, Procedure ), coins_puzzle_solution( Counterfeits, Procedure ). </syntaxhighlight> A procedure is either 'done', identifying a particular coin and whether it is 'heavy' or 'light'; or it is a 'step'. A step defines the coins to be placed on the <var>Left</var> and <var>Right</var> pans, with the residue remaining on the <var>Table</var>, and three <var>Branches</var>, one of which will be chosen depending on the outcome of the weighing. <syntaxhighlight lang="prolog"> step( step(Left,Right,Table,Branches), Left, Right, Table, Branches). </syntaxhighlight> The <var>Branches</var> are three procedures equating to: * > (left pan heavier), * < (right pan heavier) and * <nowiki>= (pans balance).</nowiki> <syntaxhighlight lang="prolog"> branch( >, branches(_Equal, GT, _LT), GT ). branch( <, branches(_Equal, _GT, LT), LT ). branch( =, branches(Equal, _GT, _LT), Equal ). </syntaxhighlight> The counterfeit is defined by its number and whether it is heavy or light. <syntaxhighlight lang="prolog"> counterfeit( counterfeit(Coin, HeavyOrLight), Coin, HeavyOrLight ). coins( [1,2,3,4,5,6,7,8,9,10,11,12] ). counterfeit_weight( heavy ). counterfeit_weight( light ). </syntaxhighlight> A 'coin collection' comprises four 'parts' (subsets): the <code>known_true</code>, <code>not_heavy</code>, <code>not_light</code> and <code>untested</code> sets of coins. <syntaxhighlight lang="prolog"> part( known_true, collection(Coins,_,_,_), Coins ). part( not_heavy, collection(_,Coins,_,_), Coins ). part( not_light, collection(_,_,Coins,_), Coins ). part( untested, collection(_,_,_,Coins), Coins ). </syntaxhighlight> ==Solution== ====solve_coins( +Counterfeit, ?Procedure )==== holds when <var> Procedure</var> can correctly identify the <var>Counterfeit</var> coin. Beginning with a 'start' collection, in which all the coins are untested, the <var>Procedure</var> comprises three 'steps'. For each step a 'weighing' is made and a 'branch' is made in the <var>Procedure</var>, depending on the result of the weighing. After three steps, the <var>Procedure</var> must have reached the 'end' condition. Finally, an assertion (redundant test) ensures that the <var> Procedure</var> has found the correct end condition. <syntaxhighlight lang="prolog"> solve_coins( Counterfeit, Procedure ) :- start( Coins0 ), assay( Counterfeit, Coins0, Procedure, Branch1, Coins1 ), assay( Counterfeit, Coins1, Branch1, Branch2, Coins2 ), assay( Counterfeit, Coins2, Branch2, done(Coin, HeavyOrLight), Coins3 ), end( Coins3, Coin, HeavyOrLight ), counterfeit( Counterfeit, Coin, HeavyOrLight ). start( Coins ) :- coins( Untested ), part( untested, Coins, Untested ), part( not_heavy, Coins, [] ), part( not_light, Coins, [] ), part( known_true, Coins, [] ). end( Coins, Coin, HeavyOrLight ) :- part( untested, Coins, [] ), part( not_heavy, Coins, Light ), part( not_light, Coins, Heavy ), end_result( Heavy, Light, Coin, HeavyOrLight ). end_result( [Coin], [], Coin, heavy ). end_result( [], [Coin], Coin, light ). </syntaxhighlight> === Simulating the weighing process === ====assay( +Counterfeit, +Coins0, ?Step, ?Branch, ?Coins1 )==== holds when the appropriate <var>Branch</var> from <var>Step</var> is chosen by comparing the weights of two coin collections taken from the full set of coins: <var>Coins0</var>. <var>Coins1</var> is the full set of coins, updated with the inferences drawn from the weighing. <var>Counterfeit</var> is used to determine the result of the weighing. This predicate applies the critical insight into the solution of this puzzle: we have 24 (12 &times; 2) possible inputs to the procedure, with only 27 (3 &times; 3 &times; 3) possible outcomes from the weighings. Therefore, it is clear that each weighing must have a very high 'information content'. Choosing which weighing to make by estimating the available information content makes the problem tractable. <syntaxhighlight lang="prolog"> assay( Counterfeit, Coins0, Step, Branch, Coins ) :- WeighingDatum = weighing_data(InfoContent, Left, Right, Table), step( Step, Left, Right, Table, Branches ), findall( WeighingDatum, valid_partition( Coins0, InfoContent, Left, Right, Table ), WeighingData ), sort( WeighingData, OrderedWeighingData ), member( WeighingDatum, OrderedWeighingData ), balance( Left, Right, Counterfeit, Result ), draw_inferences( Result, Left, Right, Table, Coins ), branch( Result, Branches, Branch ). </syntaxhighlight> ====balance( +Left, +Right, +Counterfeit, ?Result )==== holds when <var>Result</var> simulates the outcome of testing the coin collections <var>Left</var> and <var>Right</var> with a balance, where either may contain the <var>Counterfeit</var> coin. <syntaxhighlight lang="prolog"> balance( Left, Right, Counterfeit, Result ):- counterfeit( Counterfeit, Coin, Weight ), ( contains_coin( Left, Coin ) -> balance_result( Weight, normal, Result ) ; contains_coin( Right, Coin ) -> balance_result( normal, Weight, Result ) ; otherwise -> Result = '=' ). balance_result( light, normal, < ). balance_result( heavy, normal, > ). balance_result( normal, heavy, < ). balance_result( normal, light, > ). </syntaxhighlight> ===Choosing which coins to weigh=== ====valid_partition( +Coins, ?Content, ?Left, ?Right, ?Table )==== holds when <var>Coins</var> can be partitioned into three collections: <var>Left</var> side, <var>Right</var> side and <var>Table</var>; with the 'information content' of the partition given by <var>Content</var>. The definition of a 'valid partition' ensures that: * <var>Left</var> and <var>Right</var> must have the same number of coins (at least one); * <var>Left</var> cannot contain any known 'true' coins, because adding true coins to both sides creates redundant comparisons. A 'checksum' is used to ensure that only one member of each pair of symmetrical solutions can be generated. <syntaxhighlight lang="prolog"> valid_partition( Coins, Content, Left, Right, Table ):- part( known_true, Left, [] ), selection( Coins, Left, Coins1, Count, LeftChecksum, LeftInfo ), Count >= 1, selection( Coins1, Right, Table, Count, RightChecksum, RightInfo ), LeftChecksum =< RightChecksum, % Checksum to prevent symmetrical solutions table_information( Table, TableInfo ), sum( [LeftInfo,RightInfo,TableInfo], Content ). </syntaxhighlight> ====selection( +Coins, ?Sample, ?Residue, ?Count, ?Checksum, ?Content )==== holds when <var>Coins</var> is partitioned into two collections: <var>Sample</var> and <var>Residue</var>. <var>Count</var> is the number of coins in <var>Sample</var>. <var>Checksum</var> is a fingerprint for the mixture of coins in <var>Sample</var>, which has 'information content' <var>Content</var>. <syntaxhighlight lang="prolog"> selection( Coins, Sample, Residue, Count, Checksum, Content ) :- select_coins( not_heavy, Coins, Sample, Residue, Count1 ), select_coins( not_light, Coins, Sample, Residue, Count2 ), select_coins( untested, Coins, Sample, Residue, Count3 ), select_coins( known_true, Coins, Sample, Residue, Count4 ), Count is Count1+Count2+Count3+Count4, Count =< 6, Checksum is Count1+(7*Count2)+(43*Count3)+(259*Count4), information_content( [Count1,Count2,Count3,Count4], Content ). </syntaxhighlight> ====table_information( +Coins, ?Content )==== holds when <var>Coins</var> has 'information content' <var>Content</var>. <syntaxhighlight lang="prolog"> table_information( Coins, Content ) :- count_coins( not_heavy, Coins, Count1 ), count_coins( not_light, Coins, Count2 ), count_coins( untested, Coins, Count3 ), count_coins( known_true, Coins, Count4 ), information_content( [Count1,Count2,Count3,Count4], Content ). count_coins( Part, Coins, Count ) :- part( Part, Coins, Selection ), length( Selection, Count ). </syntaxhighlight> === Updating what is known about the coins === ====draw_inferences( +Result, +Left, +Right, +Table, ?Coins )==== holds when <var>Result</var> is one of: * > (imbalance - left pan heavier), * < (imbalance - right pan heavier) or * <nowiki>=</nowiki> (pans balanced) from taking a weighing with the coin collections: <var>Left</var>, <var> Right</var> and <var>Table</var>. <var>Coins</var> is derived from this information using the following rules: * If the pans are unbalanced then only the previously untested or not_heavy coins on the lighter side of the balance are now not_heavy. Similarly, only the previously untested or not_light coins on the heavier side of the balance are now not_light. All the coins on the table are now known_true. * If the pans balance then all the coins weighed are known_true, with the coins on the <var>Table</var> left in their prior states. <syntaxhighlight lang="prolog"> draw_inferences( <, Left, Right, Table, Coins ) :- imbalance_inferences( Left, Right, Table, Coins ). draw_inferences( >, Left, Right, Table, Coins ) :- imbalance_inferences( Right, Left, Table, Coins ). draw_inferences( =, Left, Right, Table, Coins ) :- inference( [all(Left),known_true(Table),all(Right)], known_true( Coins ) ), inference( untested(Table), untested(Coins) ), inference( not_heavy(Table), not_heavy(Coins) ), inference( not_light(Table), not_light(Coins) ). </syntaxhighlight> ====imbalance_inferences( +Lighter, +Heavier, +Table, ?Coins )==== holds when: * All untested or not_heavy coins in <var>Lighter</var> are not_heavy in <var>Coins </var>; * All untested or not_light coins in <var>Heavier</var> are not_light in <var>Coins </var>; * All coins in <var>Table</var> are known_true in <var>Coins</var>; There are no untested coins in <var>Coins</var>. <syntaxhighlight lang="prolog"> imbalance_inferences( Lighter, Heavier, Table, Coins ) :- inference( [untested(Lighter),not_heavy(Lighter)], not_heavy(Coins) ), inference( [untested(Heavier),not_light(Heavier)], not_light(Coins) ), inference( [ known_true(Lighter), not_light(Lighter), known_true(Heavier), not_heavy(Heavier), all(Table) ], known_true(Coins) ), part( untested, Coins, [] ). </syntaxhighlight> ====inference( +CollectionA, ?CollectionB )==== holds when (part) <var>CollectionB</var> comprises the same coins as (part) <var>CollectionA</var>. <syntaxhighlight lang="prolog"> inference( CollectionA, CollectionB ) :- unfolded( CollectionA, Coins ), unfolded( CollectionB, Coins ). </syntaxhighlight> ====unfolded( +Collection, ?Coins )==== holds when (part) <var>Collection</var> comprises <var>Coins</var>. <syntaxhighlight lang="prolog"> unfolded( not_light(Collection), Coins ) :- part( not_light, Collection, Coins ). unfolded( not_heavy(Collection), Coins ) :- part( not_heavy, Collection, Coins ). unfolded( known_true(Collection), Coins ) :- part( known_true, Collection, Coins ). unfolded( untested(Collection), Coins ) :- part( untested, Collection, Coins ). unfolded( all(Collection), Coins ) :- collection_to_set( Collection, Coins ). unfolded( [Item|Items], Coins ) :- unfolded( Item, Value ), unfolded1( Items, Value, Coins ). unfolded1( [], Coins, Coins ). unfolded1( [Item|Items], Value, Coins ) :- unfolded( Item, Value0 ), ord_union( Value0, Value, Value1 ), unfolded1( Items, Value1, Coins ). </syntaxhighlight> ==Definite Clause Grammar== The following DCG represents the method for finding the counterfeit coin as a 'structured' procedure. <syntaxhighlight lang="prolog"> general_explanation( Procedure ) --> "Number the coins 1..12", newline, explanation( Procedure, 0 ). explanation( done(Coin, Weight), N ) --> tab( N ), "Conclude that the counterfeit coin is number ", literal( Coin ), ", which is ", literal( Weight ), newline. explanation( Step, N ) --> {step( Step, Left, Right, Table, Branches )}, tab( N ), "BEGIN", newline, tab( N ), "Put ", literal( Left ), " on the left-hand pan", newline, tab( N ), "Put ", literal( Right ), " on the right-hand pan", newline, tab( N ), "Leaving ", literal( Table ), " on the table", newline, branches_explained( Branches, N ), tab( N ), "END", newline. branches_explained( Branches, N ) --> next_step_explained( <, Branches, N ), next_step_explained( >, Branches, N ), next_step_explained( =, Branches, N ). next_step_explained( Result, Branch, N ) --> {branch( Result, Branch, Step )}, ( {var(Step)} -> "" | {nonvar(Step)} -> tab( N ), "If the ", literal( Result ), " then:", newline, explanation( Step, s(N) ) ). literal( 0 ) --> "0". literal( 1 ) --> "1". literal( 2 ) --> "2". literal( 3 ) --> "3". literal( 4 ) --> "4". literal( 5 ) --> "5". literal( 6 ) --> "6". literal( 7 ) --> "7". literal( 8 ) --> "8". literal( 9 ) --> "9". literal( 10 ) --> "10". literal( 11 ) --> "11". literal( 12 ) --> "12". literal( true ) --> "true". literal( heavy ) --> "heavy". literal( light ) --> "light". literal( = ) --> "pans balance". literal( < ) --> "right-hand pan is heavier". literal( > ) --> "left-hand pan is heavier". literal( Collection ) --> {collection_to_set( Collection , [H|T] )}, literal_set( T, H ). literal_set( [], Number ) --> "the coin numbered ", literal( Number ). literal_set( [H|T], Number ) --> "the coins numbered ", literal( Number ), literal_set1( T, H ). literal_set1( [], Number ) --> " and ", literal( Number ). literal_set1( [H|T], Number ) --> ", ", literal( Number ), literal_set1( T, H ). tab( 0 ) --> "". tab( s(N) ) --> " ", tab( N ). newline --> " ". </syntaxhighlight> ===Utility Predicates=== ====contains_coin( ?Collection, ?Coin )==== holds when <var>Coin</var> is a member of <var>Collection</var>. <syntaxhighlight lang="prolog"> contains_coin( Collection, Coin ) :- part( _Part, Collection, Coins ), member( Coin, Coins ). </syntaxhighlight> ====collection_to_set( +Collection, ?Set )==== holds when <var>Set</var> is the distributed union of the <code>known_true</code>, <code>not_heavy</code>, <code>not_light</code> and <code>untested</code> ordsets comprising <var>Collection</var>. <syntaxhighlight lang="prolog"> collection_to_set( Collection, Set ) :- part( known_true, Collection, KnownTrue ), part( not_heavy, Collection, NotHeavy ), part( not_light, Collection, NotLight ), part( untested, Collection, Untested ), ord_union( [KnownTrue,NotHeavy,NotLight,Untested], Set ). </syntaxhighlight> ==== information_content( +Counts, ?Content ) ==== holds when <var>Content</var> is the cumulative negative entropy of <var>Counts</var>. A reduction in entropy equates to a gain in information. <syntaxhighlight lang="prolog"> information_content( Counts, Content ) :- information_content1( Counts, 0, Content ). information_content1( [], Content, Content ). information_content1( [Count|Counts], Content0, Content ):- coins_entropy( Count, Entropy ), Content1 is Content0-Entropy, information_content1( Counts, Content1, Content ). </syntaxhighlight> ==== coins_entropy( ?N, ?Entropy ) ==== holds when <var>Entropy</var> estimates the entropy of a sample of <var>N</var> coins. <var>Entropy</var> = P log₂(1/P), where P = <var>N</var>/12. <syntaxhighlight lang="prolog"> coins_entropy( 0, 0.0 ). coins_entropy( 1, 0.2987 ). coins_entropy( 2, 0.4308 ). coins_entropy( 3, 0.5 ). coins_entropy( 4, 0.5283 ). coins_entropy( 5, 0.5263 ). coins_entropy( 6, 0.5 ). coins_entropy( 7, 0.4536 ). coins_entropy( 8, 0.39 ). coins_entropy( 9, 0.3113 ). coins_entropy( 10, 0.2192 ). coins_entropy( 11, 0.1151 ). coins_entropy( 12, 0.0 ). </syntaxhighlight> ====select_coins( +Part, +Coins, ?Sample, ?Residue, ?N )==== holds when <var>N</var> coins from <var>Part</var> of <var>Coins</var> form <var>Part</var> of <var>Sample</var>, with the remainder forming <var>Part</var> of <var>Residue</var>. <syntaxhighlight lang="prolog"> select_coins( Part, Coins, Sample, Residue, Count ) :- part( Part, Coins, Input ), part( Part, Sample, Selection ), part( Part, Residue, Remainder ), select_n( Count, Input, Selection, Remainder ). select_n( 0, In, [], In ). select_n( 1, [A|Suffix], [A], Suffix ). select_n( 2, [A,B|Suffix], [A,B], Suffix ). select_n( 3, [A,B,C|Suffix], [A,B,C], Suffix ). select_n( 4, [A,B,C,D|Suffix], [A,B,C,D], Suffix ). select_n( 5, [A,B,C,D,E|Suffix], [A,B,C,D,E], Suffix ). select_n( 6, [A,B,C,D,E,F|Suffix], [A,B,C,D,E,F], Suffix ). </syntaxhighlight> Load a small library of [https://binding-time.co.uk/misc.html puzzle utilities]. <syntaxhighlight lang="prolog"> :- ensure_loaded( misc ). </syntaxhighlight> Use the ordsets library. <syntaxhighlight lang="prolog"> :- use_module( library(ordsets), [ord_union/2,ord_union/3] ). </syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/counterfeit.txt here]. ==Output== <div class="result"> Number the coins 1..12 BEGIN Put the coins numbered 1, 2, 3 and 4 on the left-hand pan Put the coins numbered 5, 6, 7 and 8 on the right-hand pan Leaving the coins numbered 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 1, 2, 5 and 6 on the left-hand pan Put the coins numbered 3, 7, 9 and 10 on the right-hand pan Leaving the coins numbered 4, 8, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 1 and 7 on the left-hand pan Put the coins numbered 3 and 4 on the right-hand pan Leaving the coins numbered 2, 5, 6, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 1, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 7, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 2, which is light END If the left-hand pan is heavier then: BEGIN Put the coins numbered 3 and 5 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 4, 6, 7, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 3, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 5, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 6, which is heavy END If the pans balance then: BEGIN Put the coins numbered 4 and 8 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 3, 5, 6, 7, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 4, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 8, which is heavy END END If the left-hand pan is heavier then: BEGIN Put the coins numbered 1, 2, 5 and 6 on the left-hand pan Put the coins numbered 3, 7, 9 and 10 on the right-hand pan Leaving the coins numbered 4, 8, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 3 and 5 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 4, 6, 7, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 5, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 3, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 6, which is light END If the left-hand pan is heavier then: BEGIN Put the coins numbered 1 and 7 on the left-hand pan Put the coins numbered 3 and 4 on the right-hand pan Leaving the coins numbered 2, 5, 6, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 7, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 1, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 2, which is heavy END If the pans balance then: BEGIN Put the coins numbered 4 and 8 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 3, 5, 6, 7, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 8, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 4, which is heavy END END If the pans balance then: BEGIN Put the coins numbered 9, 10 and 11 on the left-hand pan Put the coins numbered 1, 2 and 3 on the right-hand pan Leaving the coins numbered 4, 5, 6, 7, 8 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coin numbered 9 on the left-hand pan Put the coin numbered 10 on the right-hand pan Leaving the coins numbered 1, 2, 3, 4, 5, 6, 7, 8, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 9, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 10, which is light If the pans balance then: Conclude that the counterfeit coin is number 11, which is light END If the left-hand pan is heavier then: BEGIN Put the coin numbered 9 on the left-hand pan Put the coin numbered 10 on the right-hand pan Leaving the coins numbered 1, 2, 3, 4, 5, 6, 7, 8, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 10, which is heavy If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 9, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 11, which is heavy END If the pans balance then: BEGIN Put the coin numbered 12 on the left-hand pan Put the coin numbered 1 on the right-hand pan Leaving the coins numbered 2, 3, 4, 5, 6, 7, 8, 9, 10 and 11 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 12, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 12, which is heavy END END END </div> ---- 1343ffcb3007419e0c32316159aa3e703884d1b5 24 23 2013-08-10T21:44:30Z John 2 /* select_coins( +Part, +Coins, ?Sample, ?Residue, ?N ) */ wikitext text/x-wiki __NOTOC__ ==Problem Definition== We are given 12 apparently identical coins - one of which is counterfeit. We know that the counterfeit has a different weight from the others, but we don't know if it's heavier or lighter. ===Task:=== Devise a procedure to identify any counterfeit coin using a balance to take up to three comparative weighings. ==Strategy== The information from three suitable weighings will make all but one of the 'coins', which are untested initially, 'known true'. There are three alternative deductions that make a coin 'known true': * if it is 'not heavy' and 'not light' - having been on both the comparatively lighter and heavier sides of imbalances; * if it was excluded from an imbalance; * if it was included in a balanced weighing. After three weighings there must be exactly one coin, the counterfeit, which is not 'true'. If the counterfeit is not true and 'not heavy' we deduce that it must be light. If it is not true and 'not light', it must be heavy. We use a 'generate-and-test' method as follows: * Create the set of all possible 'counterfeits': 12 coins &times; 2 weights ; * Devise a procedure that can identify the first counterfeit coin; * Show that the same procedure works for every other counterfeit. ==Entry Point== ====go==== is the entry point. It solves the puzzle, then uses a DCG to pretty-print the resulting procedure. <syntaxhighlight lang="prolog"> go :- coins_puzzle( Procedure ), phrase( general_explanation( Procedure ), Chars ), put_chars( Chars ). </syntaxhighlight> ====coins_puzzle( ?Procedure )==== generates the set of all possible 'counterfeits' and finds (or proves) that <var>Procedure</var> can identify them all. <syntaxhighlight lang="prolog"> coins_puzzle( Procedure ) :- coins( Coins ), counterfeit( Counterfeit, Coin, Weight ), findall( Counterfeit, (member(Coin,Coins), counterfeit_weight(Weight)), Counterfeits ), coins_puzzle_solution( Counterfeits, Procedure ). coins_puzzle_solution( [], _Procedure ). coins_puzzle_solution( [Counterfeit|Counterfeits], Procedure ) :- solve_coins( Counterfeit, Procedure ), coins_puzzle_solution( Counterfeits, Procedure ). </syntaxhighlight> A procedure is either 'done', identifying a particular coin and whether it is 'heavy' or 'light'; or it is a 'step'. A step defines the coins to be placed on the <var>Left</var> and <var>Right</var> pans, with the residue remaining on the <var>Table</var>, and three <var>Branches</var>, one of which will be chosen depending on the outcome of the weighing. <syntaxhighlight lang="prolog"> step( step(Left,Right,Table,Branches), Left, Right, Table, Branches). </syntaxhighlight> The <var>Branches</var> are three procedures equating to: * > (left pan heavier), * < (right pan heavier) and * <nowiki>= (pans balance).</nowiki> <syntaxhighlight lang="prolog"> branch( >, branches(_Equal, GT, _LT), GT ). branch( <, branches(_Equal, _GT, LT), LT ). branch( =, branches(Equal, _GT, _LT), Equal ). </syntaxhighlight> The counterfeit is defined by its number and whether it is heavy or light. <syntaxhighlight lang="prolog"> counterfeit( counterfeit(Coin, HeavyOrLight), Coin, HeavyOrLight ). coins( [1,2,3,4,5,6,7,8,9,10,11,12] ). counterfeit_weight( heavy ). counterfeit_weight( light ). </syntaxhighlight> A 'coin collection' comprises four 'parts' (subsets): the <code>known_true</code>, <code>not_heavy</code>, <code>not_light</code> and <code>untested</code> sets of coins. <syntaxhighlight lang="prolog"> part( known_true, collection(Coins,_,_,_), Coins ). part( not_heavy, collection(_,Coins,_,_), Coins ). part( not_light, collection(_,_,Coins,_), Coins ). part( untested, collection(_,_,_,Coins), Coins ). </syntaxhighlight> ==Solution== ====solve_coins( +Counterfeit, ?Procedure )==== holds when <var> Procedure</var> can correctly identify the <var>Counterfeit</var> coin. Beginning with a 'start' collection, in which all the coins are untested, the <var>Procedure</var> comprises three 'steps'. For each step a 'weighing' is made and a 'branch' is made in the <var>Procedure</var>, depending on the result of the weighing. After three steps, the <var>Procedure</var> must have reached the 'end' condition. Finally, an assertion (redundant test) ensures that the <var> Procedure</var> has found the correct end condition. <syntaxhighlight lang="prolog"> solve_coins( Counterfeit, Procedure ) :- start( Coins0 ), assay( Counterfeit, Coins0, Procedure, Branch1, Coins1 ), assay( Counterfeit, Coins1, Branch1, Branch2, Coins2 ), assay( Counterfeit, Coins2, Branch2, done(Coin, HeavyOrLight), Coins3 ), end( Coins3, Coin, HeavyOrLight ), counterfeit( Counterfeit, Coin, HeavyOrLight ). start( Coins ) :- coins( Untested ), part( untested, Coins, Untested ), part( not_heavy, Coins, [] ), part( not_light, Coins, [] ), part( known_true, Coins, [] ). end( Coins, Coin, HeavyOrLight ) :- part( untested, Coins, [] ), part( not_heavy, Coins, Light ), part( not_light, Coins, Heavy ), end_result( Heavy, Light, Coin, HeavyOrLight ). end_result( [Coin], [], Coin, heavy ). end_result( [], [Coin], Coin, light ). </syntaxhighlight> === Simulating the weighing process === ====assay( +Counterfeit, +Coins0, ?Step, ?Branch, ?Coins1 )==== holds when the appropriate <var>Branch</var> from <var>Step</var> is chosen by comparing the weights of two coin collections taken from the full set of coins: <var>Coins0</var>. <var>Coins1</var> is the full set of coins, updated with the inferences drawn from the weighing. <var>Counterfeit</var> is used to determine the result of the weighing. This predicate applies the critical insight into the solution of this puzzle: we have 24 (12 &times; 2) possible inputs to the procedure, with only 27 (3 &times; 3 &times; 3) possible outcomes from the weighings. Therefore, it is clear that each weighing must have a very high 'information content'. Choosing which weighing to make by estimating the available information content makes the problem tractable. <syntaxhighlight lang="prolog"> assay( Counterfeit, Coins0, Step, Branch, Coins ) :- WeighingDatum = weighing_data(InfoContent, Left, Right, Table), step( Step, Left, Right, Table, Branches ), findall( WeighingDatum, valid_partition( Coins0, InfoContent, Left, Right, Table ), WeighingData ), sort( WeighingData, OrderedWeighingData ), member( WeighingDatum, OrderedWeighingData ), balance( Left, Right, Counterfeit, Result ), draw_inferences( Result, Left, Right, Table, Coins ), branch( Result, Branches, Branch ). </syntaxhighlight> ====balance( +Left, +Right, +Counterfeit, ?Result )==== holds when <var>Result</var> simulates the outcome of testing the coin collections <var>Left</var> and <var>Right</var> with a balance, where either may contain the <var>Counterfeit</var> coin. <syntaxhighlight lang="prolog"> balance( Left, Right, Counterfeit, Result ):- counterfeit( Counterfeit, Coin, Weight ), ( contains_coin( Left, Coin ) -> balance_result( Weight, normal, Result ) ; contains_coin( Right, Coin ) -> balance_result( normal, Weight, Result ) ; otherwise -> Result = '=' ). balance_result( light, normal, < ). balance_result( heavy, normal, > ). balance_result( normal, heavy, < ). balance_result( normal, light, > ). </syntaxhighlight> ===Choosing which coins to weigh=== ====valid_partition( +Coins, ?Content, ?Left, ?Right, ?Table )==== holds when <var>Coins</var> can be partitioned into three collections: <var>Left</var> side, <var>Right</var> side and <var>Table</var>; with the 'information content' of the partition given by <var>Content</var>. The definition of a 'valid partition' ensures that: * <var>Left</var> and <var>Right</var> must have the same number of coins (at least one); * <var>Left</var> cannot contain any known 'true' coins, because adding true coins to both sides creates redundant comparisons. A 'checksum' is used to ensure that only one member of each pair of symmetrical solutions can be generated. <syntaxhighlight lang="prolog"> valid_partition( Coins, Content, Left, Right, Table ):- part( known_true, Left, [] ), selection( Coins, Left, Coins1, Count, LeftChecksum, LeftInfo ), Count >= 1, selection( Coins1, Right, Table, Count, RightChecksum, RightInfo ), LeftChecksum =< RightChecksum, % Checksum to prevent symmetrical solutions table_information( Table, TableInfo ), sum( [LeftInfo,RightInfo,TableInfo], Content ). </syntaxhighlight> ====selection( +Coins, ?Sample, ?Residue, ?Count, ?Checksum, ?Content )==== holds when <var>Coins</var> is partitioned into two collections: <var>Sample</var> and <var>Residue</var>. <var>Count</var> is the number of coins in <var>Sample</var>. <var>Checksum</var> is a fingerprint for the mixture of coins in <var>Sample</var>, which has 'information content' <var>Content</var>. <syntaxhighlight lang="prolog"> selection( Coins, Sample, Residue, Count, Checksum, Content ) :- select_coins( not_heavy, Coins, Sample, Residue, Count1 ), select_coins( not_light, Coins, Sample, Residue, Count2 ), select_coins( untested, Coins, Sample, Residue, Count3 ), select_coins( known_true, Coins, Sample, Residue, Count4 ), Count is Count1+Count2+Count3+Count4, Count =< 6, Checksum is Count1+(7*Count2)+(43*Count3)+(259*Count4), information_content( [Count1,Count2,Count3,Count4], Content ). </syntaxhighlight> ====table_information( +Coins, ?Content )==== holds when <var>Coins</var> has 'information content' <var>Content</var>. <syntaxhighlight lang="prolog"> table_information( Coins, Content ) :- count_coins( not_heavy, Coins, Count1 ), count_coins( not_light, Coins, Count2 ), count_coins( untested, Coins, Count3 ), count_coins( known_true, Coins, Count4 ), information_content( [Count1,Count2,Count3,Count4], Content ). count_coins( Part, Coins, Count ) :- part( Part, Coins, Selection ), length( Selection, Count ). </syntaxhighlight> === Updating what is known about the coins === ====draw_inferences( +Result, +Left, +Right, +Table, ?Coins )==== holds when <var>Result</var> is one of: * > (imbalance - left pan heavier), * < (imbalance - right pan heavier) or * <nowiki>=</nowiki> (pans balanced) from taking a weighing with the coin collections: <var>Left</var>, <var> Right</var> and <var>Table</var>. <var>Coins</var> is derived from this information using the following rules: * If the pans are unbalanced then only the previously untested or not_heavy coins on the lighter side of the balance are now not_heavy. Similarly, only the previously untested or not_light coins on the heavier side of the balance are now not_light. All the coins on the table are now known_true. * If the pans balance then all the coins weighed are known_true, with the coins on the <var>Table</var> left in their prior states. <syntaxhighlight lang="prolog"> draw_inferences( <, Left, Right, Table, Coins ) :- imbalance_inferences( Left, Right, Table, Coins ). draw_inferences( >, Left, Right, Table, Coins ) :- imbalance_inferences( Right, Left, Table, Coins ). draw_inferences( =, Left, Right, Table, Coins ) :- inference( [all(Left),known_true(Table),all(Right)], known_true( Coins ) ), inference( untested(Table), untested(Coins) ), inference( not_heavy(Table), not_heavy(Coins) ), inference( not_light(Table), not_light(Coins) ). </syntaxhighlight> ====imbalance_inferences( +Lighter, +Heavier, +Table, ?Coins )==== holds when: * All untested or not_heavy coins in <var>Lighter</var> are not_heavy in <var>Coins </var>; * All untested or not_light coins in <var>Heavier</var> are not_light in <var>Coins </var>; * All coins in <var>Table</var> are known_true in <var>Coins</var>; There are no untested coins in <var>Coins</var>. <syntaxhighlight lang="prolog"> imbalance_inferences( Lighter, Heavier, Table, Coins ) :- inference( [untested(Lighter),not_heavy(Lighter)], not_heavy(Coins) ), inference( [untested(Heavier),not_light(Heavier)], not_light(Coins) ), inference( [ known_true(Lighter), not_light(Lighter), known_true(Heavier), not_heavy(Heavier), all(Table) ], known_true(Coins) ), part( untested, Coins, [] ). </syntaxhighlight> ====inference( +CollectionA, ?CollectionB )==== holds when (part) <var>CollectionB</var> comprises the same coins as (part) <var>CollectionA</var>. <syntaxhighlight lang="prolog"> inference( CollectionA, CollectionB ) :- unfolded( CollectionA, Coins ), unfolded( CollectionB, Coins ). </syntaxhighlight> ====unfolded( +Collection, ?Coins )==== holds when (part) <var>Collection</var> comprises <var>Coins</var>. <syntaxhighlight lang="prolog"> unfolded( not_light(Collection), Coins ) :- part( not_light, Collection, Coins ). unfolded( not_heavy(Collection), Coins ) :- part( not_heavy, Collection, Coins ). unfolded( known_true(Collection), Coins ) :- part( known_true, Collection, Coins ). unfolded( untested(Collection), Coins ) :- part( untested, Collection, Coins ). unfolded( all(Collection), Coins ) :- collection_to_set( Collection, Coins ). unfolded( [Item|Items], Coins ) :- unfolded( Item, Value ), unfolded1( Items, Value, Coins ). unfolded1( [], Coins, Coins ). unfolded1( [Item|Items], Value, Coins ) :- unfolded( Item, Value0 ), ord_union( Value0, Value, Value1 ), unfolded1( Items, Value1, Coins ). </syntaxhighlight> ==Definite Clause Grammar== The following DCG represents the method for finding the counterfeit coin as a 'structured' procedure. <syntaxhighlight lang="prolog"> general_explanation( Procedure ) --> "Number the coins 1..12", newline, explanation( Procedure, 0 ). explanation( done(Coin, Weight), N ) --> tab( N ), "Conclude that the counterfeit coin is number ", literal( Coin ), ", which is ", literal( Weight ), newline. explanation( Step, N ) --> {step( Step, Left, Right, Table, Branches )}, tab( N ), "BEGIN", newline, tab( N ), "Put ", literal( Left ), " on the left-hand pan", newline, tab( N ), "Put ", literal( Right ), " on the right-hand pan", newline, tab( N ), "Leaving ", literal( Table ), " on the table", newline, branches_explained( Branches, N ), tab( N ), "END", newline. branches_explained( Branches, N ) --> next_step_explained( <, Branches, N ), next_step_explained( >, Branches, N ), next_step_explained( =, Branches, N ). next_step_explained( Result, Branch, N ) --> {branch( Result, Branch, Step )}, ( {var(Step)} -> "" | {nonvar(Step)} -> tab( N ), "If the ", literal( Result ), " then:", newline, explanation( Step, s(N) ) ). literal( 0 ) --> "0". literal( 1 ) --> "1". literal( 2 ) --> "2". literal( 3 ) --> "3". literal( 4 ) --> "4". literal( 5 ) --> "5". literal( 6 ) --> "6". literal( 7 ) --> "7". literal( 8 ) --> "8". literal( 9 ) --> "9". literal( 10 ) --> "10". literal( 11 ) --> "11". literal( 12 ) --> "12". literal( true ) --> "true". literal( heavy ) --> "heavy". literal( light ) --> "light". literal( = ) --> "pans balance". literal( < ) --> "right-hand pan is heavier". literal( > ) --> "left-hand pan is heavier". literal( Collection ) --> {collection_to_set( Collection , [H|T] )}, literal_set( T, H ). literal_set( [], Number ) --> "the coin numbered ", literal( Number ). literal_set( [H|T], Number ) --> "the coins numbered ", literal( Number ), literal_set1( T, H ). literal_set1( [], Number ) --> " and ", literal( Number ). literal_set1( [H|T], Number ) --> ", ", literal( Number ), literal_set1( T, H ). tab( 0 ) --> "". tab( s(N) ) --> " ", tab( N ). newline --> " ". </syntaxhighlight> ===Utility Predicates=== ====contains_coin( ?Collection, ?Coin )==== holds when <var>Coin</var> is a member of <var>Collection</var>. <syntaxhighlight lang="prolog"> contains_coin( Collection, Coin ) :- part( _Part, Collection, Coins ), member( Coin, Coins ). </syntaxhighlight> ====collection_to_set( +Collection, ?Set )==== holds when <var>Set</var> is the distributed union of the <code>known_true</code>, <code>not_heavy</code>, <code>not_light</code> and <code>untested</code> ordsets comprising <var>Collection</var>. <syntaxhighlight lang="prolog"> collection_to_set( Collection, Set ) :- part( known_true, Collection, KnownTrue ), part( not_heavy, Collection, NotHeavy ), part( not_light, Collection, NotLight ), part( untested, Collection, Untested ), ord_union( [KnownTrue,NotHeavy,NotLight,Untested], Set ). </syntaxhighlight> ==== information_content( +Counts, ?Content ) ==== holds when <var>Content</var> is the cumulative negative entropy of <var>Counts</var>. A reduction in entropy equates to a gain in information. <syntaxhighlight lang="prolog"> information_content( Counts, Content ) :- information_content1( Counts, 0, Content ). information_content1( [], Content, Content ). information_content1( [Count|Counts], Content0, Content ):- coins_entropy( Count, Entropy ), Content1 is Content0-Entropy, information_content1( Counts, Content1, Content ). </syntaxhighlight> ==== coins_entropy( ?N, ?Entropy ) ==== holds when <var>Entropy</var> estimates the entropy of a sample of <var>N</var> coins. <var>Entropy</var> = P log₂(1/P), where P = <var>N</var>/12. <syntaxhighlight lang="prolog"> coins_entropy( 0, 0.0 ). coins_entropy( 1, 0.2987 ). coins_entropy( 2, 0.4308 ). coins_entropy( 3, 0.5 ). coins_entropy( 4, 0.5283 ). coins_entropy( 5, 0.5263 ). coins_entropy( 6, 0.5 ). coins_entropy( 7, 0.4536 ). coins_entropy( 8, 0.39 ). coins_entropy( 9, 0.3113 ). coins_entropy( 10, 0.2192 ). coins_entropy( 11, 0.1151 ). coins_entropy( 12, 0.0 ). </syntaxhighlight> ====select_coins( +Part, +Coins, ?Sample, ?Residue, ?N )==== holds when <var>N</var> coins from <var>Part</var> of <var>Coins</var> form <var>Part</var> of <var>Sample</var>, with the remainder forming <var>Part</var> of <var>Residue</var>. <syntaxhighlight lang="prolog"> select_coins( Part, Coins, Sample, Residue, Count ) :- part( Part, Coins, Input ), part( Part, Sample, Selection ), part( Part, Residue, Remainder ), select_n( Count, Input, Selection, Remainder ). select_n( 0, In, [], In ). select_n( 1, [A|Suffix], [A], Suffix ). select_n( 2, [A,B|Suffix], [A,B], Suffix ). select_n( 3, [A,B,C|Suffix], [A,B,C], Suffix ). select_n( 4, [A,B,C,D|Suffix], [A,B,C,D], Suffix ). select_n( 5, [A,B,C,D,E|Suffix], [A,B,C,D,E], Suffix ). select_n( 6, [A,B,C,D,E,F|Suffix], [A,B,C,D,E,F], Suffix ). </syntaxhighlight> Load a small library of [https://binding-time.co.uk/misc.html puzzle utilities]. <syntaxhighlight lang="prolog"> :- ensure_loaded( misc ). </syntaxhighlight> Use the ordsets library. <syntaxhighlight lang="prolog"> :- use_module( library(ordsets), [ord_union/2,ord_union/3] ). </syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/download/counterfeit.txt here]. ==Output== <div class="result"> Number the coins 1..12 BEGIN Put the coins numbered 1, 2, 3 and 4 on the left-hand pan Put the coins numbered 5, 6, 7 and 8 on the right-hand pan Leaving the coins numbered 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 1, 2, 5 and 6 on the left-hand pan Put the coins numbered 3, 7, 9 and 10 on the right-hand pan Leaving the coins numbered 4, 8, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 1 and 7 on the left-hand pan Put the coins numbered 3 and 4 on the right-hand pan Leaving the coins numbered 2, 5, 6, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 1, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 7, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 2, which is light END If the left-hand pan is heavier then: BEGIN Put the coins numbered 3 and 5 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 4, 6, 7, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 3, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 5, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 6, which is heavy END If the pans balance then: BEGIN Put the coins numbered 4 and 8 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 3, 5, 6, 7, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 4, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 8, which is heavy END END If the left-hand pan is heavier then: BEGIN Put the coins numbered 1, 2, 5 and 6 on the left-hand pan Put the coins numbered 3, 7, 9 and 10 on the right-hand pan Leaving the coins numbered 4, 8, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 3 and 5 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 4, 6, 7, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 5, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 3, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 6, which is light END If the left-hand pan is heavier then: BEGIN Put the coins numbered 1 and 7 on the left-hand pan Put the coins numbered 3 and 4 on the right-hand pan Leaving the coins numbered 2, 5, 6, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 7, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 1, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 2, which is heavy END If the pans balance then: BEGIN Put the coins numbered 4 and 8 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 3, 5, 6, 7, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 8, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 4, which is heavy END END If the pans balance then: BEGIN Put the coins numbered 9, 10 and 11 on the left-hand pan Put the coins numbered 1, 2 and 3 on the right-hand pan Leaving the coins numbered 4, 5, 6, 7, 8 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coin numbered 9 on the left-hand pan Put the coin numbered 10 on the right-hand pan Leaving the coins numbered 1, 2, 3, 4, 5, 6, 7, 8, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 9, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 10, which is light If the pans balance then: Conclude that the counterfeit coin is number 11, which is light END If the left-hand pan is heavier then: BEGIN Put the coin numbered 9 on the left-hand pan Put the coin numbered 10 on the right-hand pan Leaving the coins numbered 1, 2, 3, 4, 5, 6, 7, 8, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 10, which is heavy If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 9, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 11, which is heavy END If the pans balance then: BEGIN Put the coin numbered 12 on the left-hand pan Put the coin numbered 1 on the right-hand pan Leaving the coins numbered 2, 3, 4, 5, 6, 7, 8, 9, 10 and 11 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 12, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 12, which is heavy END END END </div> ---- 1f76b99fbb0789f3513d71f40878e8d8d7e2da83 41 24 2013-10-15T22:16:37Z John 2 wikitext text/x-wiki __NOTOC__ ==Problem Definition== We are given 12 apparently identical coins - one of which is counterfeit. We know that the counterfeit has a different weight from the others, but we don't know if it's heavier or lighter. ===Task:=== Devise a procedure to identify any counterfeit coin using a balance to take up to three comparative weighings. ==Strategy== The information from three suitable weighings will make all but one of the 'coins', which are untested initially, 'known true'. There are three alternative deductions that make a coin 'known true': * if it is 'not heavy' and 'not light' - having been on both the comparatively lighter and heavier sides of imbalances; * if it was excluded from an imbalance; * if it was included in a balanced weighing. After three weighings there must be exactly one coin, the counterfeit, which is not 'true'. If the counterfeit is not true and 'not heavy' we deduce that it must be light. If it is not true and 'not light', it must be heavy. We use a 'generate-and-test' method as follows: * Create the set of all possible 'counterfeits': 12 coins &times; 2 weights ; * Devise a procedure that can identify the first counterfeit coin; * Show that the same procedure works for every other counterfeit. ==Entry Point== ====go==== is the entry point. It solves the puzzle, then uses a DCG to pretty-print the resulting procedure. <syntaxhighlight lang="prolog"> go :- coins_puzzle( Procedure ), phrase( general_explanation( Procedure ), Chars ), put_chars( Chars ). </syntaxhighlight> ====coins_puzzle( ?Procedure )==== generates the set of all possible 'counterfeits' and finds (or proves) that <var>Procedure</var> can identify them all. <syntaxhighlight lang="prolog"> coins_puzzle( Procedure ) :- coins( Coins ), counterfeit( Counterfeit, Coin, Weight ), findall( Counterfeit, (member(Coin,Coins), counterfeit_weight(Weight)), Counterfeits ), coins_puzzle_solution( Counterfeits, Procedure ). coins_puzzle_solution( [], _Procedure ). coins_puzzle_solution( [Counterfeit|Counterfeits], Procedure ) :- solve_coins( Counterfeit, Procedure ), coins_puzzle_solution( Counterfeits, Procedure ). </syntaxhighlight> A procedure is either 'done', identifying a particular coin and whether it is 'heavy' or 'light'; or it is a 'step'. A step defines the coins to be placed on the <var>Left</var> and <var>Right</var> pans, with the residue remaining on the <var>Table</var>, and three <var>Branches</var>, one of which will be chosen depending on the outcome of the weighing. <syntaxhighlight lang="prolog"> step( step(Left,Right,Table,Branches), Left, Right, Table, Branches). </syntaxhighlight> The <var>Branches</var> are three procedures equating to: * > (left pan heavier), * < (right pan heavier) and * <nowiki>= (pans balance).</nowiki> <syntaxhighlight lang="prolog"> branch( >, branches(_Equal, GT, _LT), GT ). branch( <, branches(_Equal, _GT, LT), LT ). branch( =, branches(Equal, _GT, _LT), Equal ). </syntaxhighlight> The counterfeit is defined by its number and whether it is heavy or light. <syntaxhighlight lang="prolog"> counterfeit( counterfeit(Coin, HeavyOrLight), Coin, HeavyOrLight ). coins( [1,2,3,4,5,6,7,8,9,10,11,12] ). counterfeit_weight( heavy ). counterfeit_weight( light ). </syntaxhighlight> A 'coin collection' comprises four 'parts' (subsets): the <code>known_true</code>, <code>not_heavy</code>, <code>not_light</code> and <code>untested</code> sets of coins. <syntaxhighlight lang="prolog"> part( known_true, collection(Coins,_,_,_), Coins ). part( not_heavy, collection(_,Coins,_,_), Coins ). part( not_light, collection(_,_,Coins,_), Coins ). part( untested, collection(_,_,_,Coins), Coins ). </syntaxhighlight> ==Solution== ====solve_coins( +Counterfeit, ?Procedure )==== holds when <var>Procedure</var> can correctly identify the <var>Counterfeit</var> coin. Beginning with a 'start' collection, in which all the coins are untested, the <var>Procedure</var> comprises three 'steps'. For each step a 'weighing' is made and a 'branch' is made in the <var>Procedure</var>, depending on the result of the weighing. After three steps, the <var>Procedure</var> must have reached the 'end' condition. Finally, an assertion (redundant test) ensures that the <var>Procedure</var> has found the correct end condition. <syntaxhighlight lang="prolog"> solve_coins( Counterfeit, Procedure ) :- start( Coins0 ), assay( Counterfeit, Coins0, Procedure, Branch1, Coins1 ), assay( Counterfeit, Coins1, Branch1, Branch2, Coins2 ), assay( Counterfeit, Coins2, Branch2, done(Coin, HeavyOrLight), Coins3 ), end( Coins3, Coin, HeavyOrLight ), counterfeit( Counterfeit, Coin, HeavyOrLight ). start( Coins ) :- coins( Untested ), part( untested, Coins, Untested ), part( not_heavy, Coins, [] ), part( not_light, Coins, [] ), part( known_true, Coins, [] ). end( Coins, Coin, HeavyOrLight ) :- part( untested, Coins, [] ), part( not_heavy, Coins, Light ), part( not_light, Coins, Heavy ), end_result( Heavy, Light, Coin, HeavyOrLight ). end_result( [Coin], [], Coin, heavy ). end_result( [], [Coin], Coin, light ). </syntaxhighlight> === Simulating the weighing process === ====assay( +Counterfeit, +Coins0, ?Step, ?Branch, ?Coins1 )==== holds when the appropriate <var>Branch</var> from <var>Step</var> is chosen by comparing the weights of two coin collections taken from the full set of coins: <var>Coins0</var>. <var>Coins1</var> is the full set of coins, updated with the inferences drawn from the weighing. <var>Counterfeit</var> is used to determine the result of the weighing. This predicate applies the critical insight into the solution of this puzzle: we have 24 (12 &times; 2) possible inputs to the procedure, with only 27 (3 &times; 3 &times; 3) possible outcomes from the weighings. Therefore, it is clear that each weighing must have a very high 'information content'. Choosing which weighing to make by estimating the available information content makes the problem tractable. <syntaxhighlight lang="prolog"> assay( Counterfeit, Coins0, Step, Branch, Coins ) :- WeighingDatum = weighing_data(InfoContent, Left, Right, Table), step( Step, Left, Right, Table, Branches ), findall( WeighingDatum, valid_partition( Coins0, InfoContent, Left, Right, Table ), WeighingData ), sort( WeighingData, OrderedWeighingData ), member( WeighingDatum, OrderedWeighingData ), balance( Left, Right, Counterfeit, Result ), draw_inferences( Result, Left, Right, Table, Coins ), branch( Result, Branches, Branch ). </syntaxhighlight> ====balance( +Left, +Right, +Counterfeit, ?Result )==== holds when <var>Result</var> simulates the outcome of testing the coin collections <var>Left</var> and <var>Right</var> with a balance, where either may contain the <var>Counterfeit</var> coin. <syntaxhighlight lang="prolog"> balance( Left, Right, Counterfeit, Result ):- counterfeit( Counterfeit, Coin, Weight ), ( contains_coin( Left, Coin ) -> balance_result( Weight, normal, Result ) ; contains_coin( Right, Coin ) -> balance_result( normal, Weight, Result ) ; otherwise -> Result = '=' ). balance_result( light, normal, < ). balance_result( heavy, normal, > ). balance_result( normal, heavy, < ). balance_result( normal, light, > ). </syntaxhighlight> ===Choosing which coins to weigh=== ====valid_partition( +Coins, ?Content, ?Left, ?Right, ?Table )==== holds when <var>Coins</var> can be partitioned into three collections: <var>Left</var> side, <var>Right</var> side and <var>Table</var>; with the 'information content' of the partition given by <var>Content</var>. The definition of a 'valid partition' ensures that: * <var>Left</var> and <var>Right</var> must have the same number of coins (at least one); * <var>Left</var> cannot contain any known 'true' coins, because adding true coins to both sides creates redundant comparisons. A 'checksum' is used to ensure that only one member of each pair of symmetrical solutions can be generated. <syntaxhighlight lang="prolog"> valid_partition( Coins, Content, Left, Right, Table ):- part( known_true, Left, [] ), selection( Coins, Left, Coins1, Count, LeftChecksum, LeftInfo ), Count >= 1, selection( Coins1, Right, Table, Count, RightChecksum, RightInfo ), LeftChecksum =< RightChecksum, % Checksum to prevent symmetrical solutions table_information( Table, TableInfo ), sum( [LeftInfo,RightInfo,TableInfo], Content ). </syntaxhighlight> ====selection( +Coins, ?Sample, ?Residue, ?Count, ?Checksum, ?Content )==== holds when <var>Coins</var> is partitioned into two collections: <var>Sample</var> and <var>Residue</var>. <var>Count</var> is the number of coins in <var>Sample</var>. <var>Checksum</var> is a fingerprint for the mixture of coins in <var>Sample</var>, which has 'information content' <var>Content</var>. <syntaxhighlight lang="prolog"> selection( Coins, Sample, Residue, Count, Checksum, Content ) :- select_coins( not_heavy, Coins, Sample, Residue, Count1 ), select_coins( not_light, Coins, Sample, Residue, Count2 ), select_coins( untested, Coins, Sample, Residue, Count3 ), select_coins( known_true, Coins, Sample, Residue, Count4 ), Count is Count1+Count2+Count3+Count4, Count =< 6, Checksum is Count1+(7*Count2)+(43*Count3)+(259*Count4), information_content( [Count1,Count2,Count3,Count4], Content ). </syntaxhighlight> ====table_information( +Coins, ?Content )==== holds when <var>Coins</var> has 'information content' <var>Content</var>. <syntaxhighlight lang="prolog"> table_information( Coins, Content ) :- count_coins( not_heavy, Coins, Count1 ), count_coins( not_light, Coins, Count2 ), count_coins( untested, Coins, Count3 ), count_coins( known_true, Coins, Count4 ), information_content( [Count1,Count2,Count3,Count4], Content ). count_coins( Part, Coins, Count ) :- part( Part, Coins, Selection ), length( Selection, Count ). </syntaxhighlight> === Updating what is known about the coins === ====draw_inferences( +Result, +Left, +Right, +Table, ?Coins )==== holds when <var>Result</var> is one of: * > (imbalance - left pan heavier), * < (imbalance - right pan heavier) or * <nowiki>=</nowiki> (pans balanced) from taking a weighing with the coin collections: <var>Left</var>, <var>Right</var> and <var>Table</var>. <var>Coins</var> is derived from this information using the following rules: * If the pans are unbalanced then only the previously untested or not_heavy coins on the lighter side of the balance are now not_heavy. Similarly, only the previously untested or not_light coins on the heavier side of the balance are now not_light. All the coins on the table are now known_true. * If the pans balance then all the coins weighed are known_true, with the coins on the <var>Table</var> left in their prior states. <syntaxhighlight lang="prolog"> draw_inferences( <, Left, Right, Table, Coins ) :- imbalance_inferences( Left, Right, Table, Coins ). draw_inferences( >, Left, Right, Table, Coins ) :- imbalance_inferences( Right, Left, Table, Coins ). draw_inferences( =, Left, Right, Table, Coins ) :- inference( [all(Left),known_true(Table),all(Right)], known_true( Coins ) ), inference( untested(Table), untested(Coins) ), inference( not_heavy(Table), not_heavy(Coins) ), inference( not_light(Table), not_light(Coins) ). </syntaxhighlight> ====imbalance_inferences( +Lighter, +Heavier, +Table, ?Coins )==== holds when: * All untested or not_heavy coins in <var>Lighter</var> are not_heavy in <var>Coins</var>; * All untested or not_light coins in <var>Heavier</var> are not_light in <var>Coins</var>; * All coins in <var>Table</var> are known_true in <var>Coins</var>; There are no untested coins in <var>Coins</var>. <syntaxhighlight lang="prolog"> imbalance_inferences( Lighter, Heavier, Table, Coins ) :- inference( [untested(Lighter),not_heavy(Lighter)], not_heavy(Coins) ), inference( [untested(Heavier),not_light(Heavier)], not_light(Coins) ), inference( [ known_true(Lighter), not_light(Lighter), known_true(Heavier), not_heavy(Heavier), all(Table) ], known_true(Coins) ), part( untested, Coins, [] ). </syntaxhighlight> ====inference( +CollectionA, ?CollectionB )==== holds when (part) <var>CollectionB</var> comprises the same coins as (part) <var>CollectionA</var>. <syntaxhighlight lang="prolog"> inference( CollectionA, CollectionB ) :- unfolded( CollectionA, Coins ), unfolded( CollectionB, Coins ). </syntaxhighlight> ====unfolded( +Collection, ?Coins )==== holds when (part) <var>Collection</var> comprises <var>Coins</var>. <syntaxhighlight lang="prolog"> unfolded( not_light(Collection), Coins ) :- part( not_light, Collection, Coins ). unfolded( not_heavy(Collection), Coins ) :- part( not_heavy, Collection, Coins ). unfolded( known_true(Collection), Coins ) :- part( known_true, Collection, Coins ). unfolded( untested(Collection), Coins ) :- part( untested, Collection, Coins ). unfolded( all(Collection), Coins ) :- collection_to_set( Collection, Coins ). unfolded( [Item|Items], Coins ) :- unfolded( Item, Value ), unfolded1( Items, Value, Coins ). unfolded1( [], Coins, Coins ). unfolded1( [Item|Items], Value, Coins ) :- unfolded( Item, Value0 ), ord_union( Value0, Value, Value1 ), unfolded1( Items, Value1, Coins ). </syntaxhighlight> ==Definite Clause Grammar== The following DCG represents the method for finding the counterfeit coin as a 'structured' procedure. <syntaxhighlight lang="prolog"> general_explanation( Procedure ) --> "Number the coins 1..12", newline, explanation( Procedure, 0 ). explanation( done(Coin, Weight), N ) --> tab( N ), "Conclude that the counterfeit coin is number ", literal( Coin ), ", which is ", literal( Weight ), newline. explanation( Step, N ) --> {step( Step, Left, Right, Table, Branches )}, tab( N ), "BEGIN", newline, tab( N ), "Put ", literal( Left ), " on the left-hand pan", newline, tab( N ), "Put ", literal( Right ), " on the right-hand pan", newline, tab( N ), "Leaving ", literal( Table ), " on the table", newline, branches_explained( Branches, N ), tab( N ), "END", newline. branches_explained( Branches, N ) --> next_step_explained( <, Branches, N ), next_step_explained( >, Branches, N ), next_step_explained( =, Branches, N ). next_step_explained( Result, Branch, N ) --> {branch( Result, Branch, Step )}, ( {var(Step)} -> "" | {nonvar(Step)} -> tab( N ), "If the ", literal( Result ), " then:", newline, explanation( Step, s(N) ) ). literal( 0 ) --> "0". literal( 1 ) --> "1". literal( 2 ) --> "2". literal( 3 ) --> "3". literal( 4 ) --> "4". literal( 5 ) --> "5". literal( 6 ) --> "6". literal( 7 ) --> "7". literal( 8 ) --> "8". literal( 9 ) --> "9". literal( 10 ) --> "10". literal( 11 ) --> "11". literal( 12 ) --> "12". literal( true ) --> "true". literal( heavy ) --> "heavy". literal( light ) --> "light". literal( = ) --> "pans balance". literal( < ) --> "right-hand pan is heavier". literal( > ) --> "left-hand pan is heavier". literal( Collection ) --> {collection_to_set( Collection , [H|T] )}, literal_set( T, H ). literal_set( [], Number ) --> "the coin numbered ", literal( Number ). literal_set( [H|T], Number ) --> "the coins numbered ", literal( Number ), literal_set1( T, H ). literal_set1( [], Number ) --> " and ", literal( Number ). literal_set1( [H|T], Number ) --> ", ", literal( Number ), literal_set1( T, H ). tab( 0 ) --> "". tab( s(N) ) --> " ", tab( N ). newline --> " ". </syntaxhighlight> ===Utility Predicates=== ====contains_coin( ?Collection, ?Coin )==== holds when <var>Coin</var> is a member of <var>Collection</var>. <syntaxhighlight lang="prolog"> contains_coin( Collection, Coin ) :- part( _Part, Collection, Coins ), member( Coin, Coins ). </syntaxhighlight> ====collection_to_set( +Collection, ?Set )==== holds when <var>Set</var> is the distributed union of the <code>known_true</code>, <code>not_heavy</code>, <code>not_light</code> and <code>untested</code> ordsets comprising <var>Collection</var>. <syntaxhighlight lang="prolog"> collection_to_set( Collection, Set ) :- part( known_true, Collection, KnownTrue ), part( not_heavy, Collection, NotHeavy ), part( not_light, Collection, NotLight ), part( untested, Collection, Untested ), ord_union( [KnownTrue,NotHeavy,NotLight,Untested], Set ). </syntaxhighlight> ==== information_content( +Counts, ?Content ) ==== holds when <var>Content</var> is the cumulative negative entropy of <var>Counts</var>. A reduction in entropy equates to a gain in information. <syntaxhighlight lang="prolog"> information_content( Counts, Content ) :- information_content1( Counts, 0, Content ). information_content1( [], Content, Content ). information_content1( [Count|Counts], Content0, Content ):- coins_entropy( Count, Entropy ), Content1 is Content0-Entropy, information_content1( Counts, Content1, Content ). </syntaxhighlight> ==== coins_entropy( ?N, ?Entropy ) ==== holds when <var>Entropy</var> estimates the entropy of a sample of <var>N</var> coins. <var>Entropy</var> = P log₂(1/P), where P = <var>N</var>/12. <syntaxhighlight lang="prolog"> coins_entropy( 0, 0.0 ). coins_entropy( 1, 0.2987 ). coins_entropy( 2, 0.4308 ). coins_entropy( 3, 0.5 ). coins_entropy( 4, 0.5283 ). coins_entropy( 5, 0.5263 ). coins_entropy( 6, 0.5 ). coins_entropy( 7, 0.4536 ). coins_entropy( 8, 0.39 ). coins_entropy( 9, 0.3113 ). coins_entropy( 10, 0.2192 ). coins_entropy( 11, 0.1151 ). coins_entropy( 12, 0.0 ). </syntaxhighlight> ====select_coins( +Part, +Coins, ?Sample, ?Residue, ?N )==== holds when <var>N</var> coins from <var>Part</var> of <var>Coins</var> form <var>Part</var> of <var>Sample</var>, with the remainder forming <var>Part</var> of <var>Residue</var>. <syntaxhighlight lang="prolog"> select_coins( Part, Coins, Sample, Residue, Count ) :- part( Part, Coins, Input ), part( Part, Sample, Selection ), part( Part, Residue, Remainder ), select_n( Count, Input, Selection, Remainder ). select_n( 0, In, [], In ). select_n( 1, [A|Suffix], [A], Suffix ). select_n( 2, [A,B|Suffix], [A,B], Suffix ). select_n( 3, [A,B,C|Suffix], [A,B,C], Suffix ). select_n( 4, [A,B,C,D|Suffix], [A,B,C,D], Suffix ). select_n( 5, [A,B,C,D,E|Suffix], [A,B,C,D,E], Suffix ). select_n( 6, [A,B,C,D,E,F|Suffix], [A,B,C,D,E,F], Suffix ). </syntaxhighlight> Load a small library of [https://binding-time.co.uk/misc.html puzzle utilities]. <syntaxhighlight lang="prolog"> :- ensure_loaded( misc ). </syntaxhighlight> Use the ordsets library. <syntaxhighlight lang="prolog"> :- use_module( library(ordsets), [ord_union/2,ord_union/3] ). </syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/download/counterfeit.txt here]. ==Output== <div class="result"> Number the coins 1..12 BEGIN Put the coins numbered 1, 2, 3 and 4 on the left-hand pan Put the coins numbered 5, 6, 7 and 8 on the right-hand pan Leaving the coins numbered 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 1, 2, 5 and 6 on the left-hand pan Put the coins numbered 3, 7, 9 and 10 on the right-hand pan Leaving the coins numbered 4, 8, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 1 and 7 on the left-hand pan Put the coins numbered 3 and 4 on the right-hand pan Leaving the coins numbered 2, 5, 6, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 1, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 7, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 2, which is light END If the left-hand pan is heavier then: BEGIN Put the coins numbered 3 and 5 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 4, 6, 7, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 3, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 5, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 6, which is heavy END If the pans balance then: BEGIN Put the coins numbered 4 and 8 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 3, 5, 6, 7, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 4, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 8, which is heavy END END If the left-hand pan is heavier then: BEGIN Put the coins numbered 1, 2, 5 and 6 on the left-hand pan Put the coins numbered 3, 7, 9 and 10 on the right-hand pan Leaving the coins numbered 4, 8, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 3 and 5 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 4, 6, 7, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 5, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 3, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 6, which is light END If the left-hand pan is heavier then: BEGIN Put the coins numbered 1 and 7 on the left-hand pan Put the coins numbered 3 and 4 on the right-hand pan Leaving the coins numbered 2, 5, 6, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 7, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 1, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 2, which is heavy END If the pans balance then: BEGIN Put the coins numbered 4 and 8 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 3, 5, 6, 7, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 8, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 4, which is heavy END END If the pans balance then: BEGIN Put the coins numbered 9, 10 and 11 on the left-hand pan Put the coins numbered 1, 2 and 3 on the right-hand pan Leaving the coins numbered 4, 5, 6, 7, 8 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coin numbered 9 on the left-hand pan Put the coin numbered 10 on the right-hand pan Leaving the coins numbered 1, 2, 3, 4, 5, 6, 7, 8, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 9, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 10, which is light If the pans balance then: Conclude that the counterfeit coin is number 11, which is light END If the left-hand pan is heavier then: BEGIN Put the coin numbered 9 on the left-hand pan Put the coin numbered 10 on the right-hand pan Leaving the coins numbered 1, 2, 3, 4, 5, 6, 7, 8, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 10, which is heavy If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 9, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 11, which is heavy END If the pans balance then: BEGIN Put the coin numbered 12 on the left-hand pan Put the coin numbered 1 on the right-hand pan Leaving the coins numbered 2, 3, 4, 5, 6, 7, 8, 9, 10 and 11 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 12, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 12, which is heavy END END END </div> ---- 301c31fa654573fbbfdfda7bd5172ec1c4b76d33 48 41 2013-10-19T19:46:58Z John 2 /* select_coins( +Part, +Coins, ?Sample, ?Residue, ?N ) */ wikitext text/x-wiki __NOTOC__ ==Problem Definition== We are given 12 apparently identical coins - one of which is counterfeit. We know that the counterfeit has a different weight from the others, but we don't know if it's heavier or lighter. ===Task:=== Devise a procedure to identify any counterfeit coin using a balance to take up to three comparative weighings. ==Strategy== The information from three suitable weighings will make all but one of the 'coins', which are untested initially, 'known true'. There are three alternative deductions that make a coin 'known true': * if it is 'not heavy' and 'not light' - having been on both the comparatively lighter and heavier sides of imbalances; * if it was excluded from an imbalance; * if it was included in a balanced weighing. After three weighings there must be exactly one coin, the counterfeit, which is not 'true'. If the counterfeit is not true and 'not heavy' we deduce that it must be light. If it is not true and 'not light', it must be heavy. We use a 'generate-and-test' method as follows: * Create the set of all possible 'counterfeits': 12 coins &times; 2 weights ; * Devise a procedure that can identify the first counterfeit coin; * Show that the same procedure works for every other counterfeit. ==Entry Point== ====go==== is the entry point. It solves the puzzle, then uses a DCG to pretty-print the resulting procedure. <syntaxhighlight lang="prolog"> go :- coins_puzzle( Procedure ), phrase( general_explanation( Procedure ), Chars ), put_chars( Chars ). </syntaxhighlight> ====coins_puzzle( ?Procedure )==== generates the set of all possible 'counterfeits' and finds (or proves) that <var>Procedure</var> can identify them all. <syntaxhighlight lang="prolog"> coins_puzzle( Procedure ) :- coins( Coins ), counterfeit( Counterfeit, Coin, Weight ), findall( Counterfeit, (member(Coin,Coins), counterfeit_weight(Weight)), Counterfeits ), coins_puzzle_solution( Counterfeits, Procedure ). coins_puzzle_solution( [], _Procedure ). coins_puzzle_solution( [Counterfeit|Counterfeits], Procedure ) :- solve_coins( Counterfeit, Procedure ), coins_puzzle_solution( Counterfeits, Procedure ). </syntaxhighlight> A procedure is either 'done', identifying a particular coin and whether it is 'heavy' or 'light'; or it is a 'step'. A step defines the coins to be placed on the <var>Left</var> and <var>Right</var> pans, with the residue remaining on the <var>Table</var>, and three <var>Branches</var>, one of which will be chosen depending on the outcome of the weighing. <syntaxhighlight lang="prolog"> step( step(Left,Right,Table,Branches), Left, Right, Table, Branches). </syntaxhighlight> The <var>Branches</var> are three procedures equating to: * > (left pan heavier), * < (right pan heavier) and * <nowiki>= (pans balance).</nowiki> <syntaxhighlight lang="prolog"> branch( >, branches(_Equal, GT, _LT), GT ). branch( <, branches(_Equal, _GT, LT), LT ). branch( =, branches(Equal, _GT, _LT), Equal ). </syntaxhighlight> The counterfeit is defined by its number and whether it is heavy or light. <syntaxhighlight lang="prolog"> counterfeit( counterfeit(Coin, HeavyOrLight), Coin, HeavyOrLight ). coins( [1,2,3,4,5,6,7,8,9,10,11,12] ). counterfeit_weight( heavy ). counterfeit_weight( light ). </syntaxhighlight> A 'coin collection' comprises four 'parts' (subsets): the <code>known_true</code>, <code>not_heavy</code>, <code>not_light</code> and <code>untested</code> sets of coins. <syntaxhighlight lang="prolog"> part( known_true, collection(Coins,_,_,_), Coins ). part( not_heavy, collection(_,Coins,_,_), Coins ). part( not_light, collection(_,_,Coins,_), Coins ). part( untested, collection(_,_,_,Coins), Coins ). </syntaxhighlight> ==Solution== ====solve_coins( +Counterfeit, ?Procedure )==== holds when <var>Procedure</var> can correctly identify the <var>Counterfeit</var> coin. Beginning with a 'start' collection, in which all the coins are untested, the <var>Procedure</var> comprises three 'steps'. For each step a 'weighing' is made and a 'branch' is made in the <var>Procedure</var>, depending on the result of the weighing. After three steps, the <var>Procedure</var> must have reached the 'end' condition. Finally, an assertion (redundant test) ensures that the <var>Procedure</var> has found the correct end condition. <syntaxhighlight lang="prolog"> solve_coins( Counterfeit, Procedure ) :- start( Coins0 ), assay( Counterfeit, Coins0, Procedure, Branch1, Coins1 ), assay( Counterfeit, Coins1, Branch1, Branch2, Coins2 ), assay( Counterfeit, Coins2, Branch2, done(Coin, HeavyOrLight), Coins3 ), end( Coins3, Coin, HeavyOrLight ), counterfeit( Counterfeit, Coin, HeavyOrLight ). start( Coins ) :- coins( Untested ), part( untested, Coins, Untested ), part( not_heavy, Coins, [] ), part( not_light, Coins, [] ), part( known_true, Coins, [] ). end( Coins, Coin, HeavyOrLight ) :- part( untested, Coins, [] ), part( not_heavy, Coins, Light ), part( not_light, Coins, Heavy ), end_result( Heavy, Light, Coin, HeavyOrLight ). end_result( [Coin], [], Coin, heavy ). end_result( [], [Coin], Coin, light ). </syntaxhighlight> === Simulating the weighing process === ====assay( +Counterfeit, +Coins0, ?Step, ?Branch, ?Coins1 )==== holds when the appropriate <var>Branch</var> from <var>Step</var> is chosen by comparing the weights of two coin collections taken from the full set of coins: <var>Coins0</var>. <var>Coins1</var> is the full set of coins, updated with the inferences drawn from the weighing. <var>Counterfeit</var> is used to determine the result of the weighing. This predicate applies the critical insight into the solution of this puzzle: we have 24 (12 &times; 2) possible inputs to the procedure, with only 27 (3 &times; 3 &times; 3) possible outcomes from the weighings. Therefore, it is clear that each weighing must have a very high 'information content'. Choosing which weighing to make by estimating the available information content makes the problem tractable. <syntaxhighlight lang="prolog"> assay( Counterfeit, Coins0, Step, Branch, Coins ) :- WeighingDatum = weighing_data(InfoContent, Left, Right, Table), step( Step, Left, Right, Table, Branches ), findall( WeighingDatum, valid_partition( Coins0, InfoContent, Left, Right, Table ), WeighingData ), sort( WeighingData, OrderedWeighingData ), member( WeighingDatum, OrderedWeighingData ), balance( Left, Right, Counterfeit, Result ), draw_inferences( Result, Left, Right, Table, Coins ), branch( Result, Branches, Branch ). </syntaxhighlight> ====balance( +Left, +Right, +Counterfeit, ?Result )==== holds when <var>Result</var> simulates the outcome of testing the coin collections <var>Left</var> and <var>Right</var> with a balance, where either may contain the <var>Counterfeit</var> coin. <syntaxhighlight lang="prolog"> balance( Left, Right, Counterfeit, Result ):- counterfeit( Counterfeit, Coin, Weight ), ( contains_coin( Left, Coin ) -> balance_result( Weight, normal, Result ) ; contains_coin( Right, Coin ) -> balance_result( normal, Weight, Result ) ; otherwise -> Result = '=' ). balance_result( light, normal, < ). balance_result( heavy, normal, > ). balance_result( normal, heavy, < ). balance_result( normal, light, > ). </syntaxhighlight> ===Choosing which coins to weigh=== ====valid_partition( +Coins, ?Content, ?Left, ?Right, ?Table )==== holds when <var>Coins</var> can be partitioned into three collections: <var>Left</var> side, <var>Right</var> side and <var>Table</var>; with the 'information content' of the partition given by <var>Content</var>. The definition of a 'valid partition' ensures that: * <var>Left</var> and <var>Right</var> must have the same number of coins (at least one); * <var>Left</var> cannot contain any known 'true' coins, because adding true coins to both sides creates redundant comparisons. A 'checksum' is used to ensure that only one member of each pair of symmetrical solutions can be generated. <syntaxhighlight lang="prolog"> valid_partition( Coins, Content, Left, Right, Table ):- part( known_true, Left, [] ), selection( Coins, Left, Coins1, Count, LeftChecksum, LeftInfo ), Count >= 1, selection( Coins1, Right, Table, Count, RightChecksum, RightInfo ), LeftChecksum =< RightChecksum, % Checksum to prevent symmetrical solutions table_information( Table, TableInfo ), sum( [LeftInfo,RightInfo,TableInfo], Content ). </syntaxhighlight> ====selection( +Coins, ?Sample, ?Residue, ?Count, ?Checksum, ?Content )==== holds when <var>Coins</var> is partitioned into two collections: <var>Sample</var> and <var>Residue</var>. <var>Count</var> is the number of coins in <var>Sample</var>. <var>Checksum</var> is a fingerprint for the mixture of coins in <var>Sample</var>, which has 'information content' <var>Content</var>. <syntaxhighlight lang="prolog"> selection( Coins, Sample, Residue, Count, Checksum, Content ) :- select_coins( not_heavy, Coins, Sample, Residue, Count1 ), select_coins( not_light, Coins, Sample, Residue, Count2 ), select_coins( untested, Coins, Sample, Residue, Count3 ), select_coins( known_true, Coins, Sample, Residue, Count4 ), Count is Count1+Count2+Count3+Count4, Count =< 6, Checksum is Count1+(7*Count2)+(43*Count3)+(259*Count4), information_content( [Count1,Count2,Count3,Count4], Content ). </syntaxhighlight> ====table_information( +Coins, ?Content )==== holds when <var>Coins</var> has 'information content' <var>Content</var>. <syntaxhighlight lang="prolog"> table_information( Coins, Content ) :- count_coins( not_heavy, Coins, Count1 ), count_coins( not_light, Coins, Count2 ), count_coins( untested, Coins, Count3 ), count_coins( known_true, Coins, Count4 ), information_content( [Count1,Count2,Count3,Count4], Content ). count_coins( Part, Coins, Count ) :- part( Part, Coins, Selection ), length( Selection, Count ). </syntaxhighlight> === Updating what is known about the coins === ====draw_inferences( +Result, +Left, +Right, +Table, ?Coins )==== holds when <var>Result</var> is one of: * > (imbalance - left pan heavier), * < (imbalance - right pan heavier) or * <nowiki>=</nowiki> (pans balanced) from taking a weighing with the coin collections: <var>Left</var>, <var>Right</var> and <var>Table</var>. <var>Coins</var> is derived from this information using the following rules: * If the pans are unbalanced then only the previously untested or not_heavy coins on the lighter side of the balance are now not_heavy. Similarly, only the previously untested or not_light coins on the heavier side of the balance are now not_light. All the coins on the table are now known_true. * If the pans balance then all the coins weighed are known_true, with the coins on the <var>Table</var> left in their prior states. <syntaxhighlight lang="prolog"> draw_inferences( <, Left, Right, Table, Coins ) :- imbalance_inferences( Left, Right, Table, Coins ). draw_inferences( >, Left, Right, Table, Coins ) :- imbalance_inferences( Right, Left, Table, Coins ). draw_inferences( =, Left, Right, Table, Coins ) :- inference( [all(Left),known_true(Table),all(Right)], known_true( Coins ) ), inference( untested(Table), untested(Coins) ), inference( not_heavy(Table), not_heavy(Coins) ), inference( not_light(Table), not_light(Coins) ). </syntaxhighlight> ====imbalance_inferences( +Lighter, +Heavier, +Table, ?Coins )==== holds when: * All untested or not_heavy coins in <var>Lighter</var> are not_heavy in <var>Coins</var>; * All untested or not_light coins in <var>Heavier</var> are not_light in <var>Coins</var>; * All coins in <var>Table</var> are known_true in <var>Coins</var>; There are no untested coins in <var>Coins</var>. <syntaxhighlight lang="prolog"> imbalance_inferences( Lighter, Heavier, Table, Coins ) :- inference( [untested(Lighter),not_heavy(Lighter)], not_heavy(Coins) ), inference( [untested(Heavier),not_light(Heavier)], not_light(Coins) ), inference( [ known_true(Lighter), not_light(Lighter), known_true(Heavier), not_heavy(Heavier), all(Table) ], known_true(Coins) ), part( untested, Coins, [] ). </syntaxhighlight> ====inference( +CollectionA, ?CollectionB )==== holds when (part) <var>CollectionB</var> comprises the same coins as (part) <var>CollectionA</var>. <syntaxhighlight lang="prolog"> inference( CollectionA, CollectionB ) :- unfolded( CollectionA, Coins ), unfolded( CollectionB, Coins ). </syntaxhighlight> ====unfolded( +Collection, ?Coins )==== holds when (part) <var>Collection</var> comprises <var>Coins</var>. <syntaxhighlight lang="prolog"> unfolded( not_light(Collection), Coins ) :- part( not_light, Collection, Coins ). unfolded( not_heavy(Collection), Coins ) :- part( not_heavy, Collection, Coins ). unfolded( known_true(Collection), Coins ) :- part( known_true, Collection, Coins ). unfolded( untested(Collection), Coins ) :- part( untested, Collection, Coins ). unfolded( all(Collection), Coins ) :- collection_to_set( Collection, Coins ). unfolded( [Item|Items], Coins ) :- unfolded( Item, Value ), unfolded1( Items, Value, Coins ). unfolded1( [], Coins, Coins ). unfolded1( [Item|Items], Value, Coins ) :- unfolded( Item, Value0 ), ord_union( Value0, Value, Value1 ), unfolded1( Items, Value1, Coins ). </syntaxhighlight> ==Definite Clause Grammar== The following DCG represents the method for finding the counterfeit coin as a 'structured' procedure. <syntaxhighlight lang="prolog"> general_explanation( Procedure ) --> "Number the coins 1..12", newline, explanation( Procedure, 0 ). explanation( done(Coin, Weight), N ) --> tab( N ), "Conclude that the counterfeit coin is number ", literal( Coin ), ", which is ", literal( Weight ), newline. explanation( Step, N ) --> {step( Step, Left, Right, Table, Branches )}, tab( N ), "BEGIN", newline, tab( N ), "Put ", literal( Left ), " on the left-hand pan", newline, tab( N ), "Put ", literal( Right ), " on the right-hand pan", newline, tab( N ), "Leaving ", literal( Table ), " on the table", newline, branches_explained( Branches, N ), tab( N ), "END", newline. branches_explained( Branches, N ) --> next_step_explained( <, Branches, N ), next_step_explained( >, Branches, N ), next_step_explained( =, Branches, N ). next_step_explained( Result, Branch, N ) --> {branch( Result, Branch, Step )}, ( {var(Step)} -> "" | {nonvar(Step)} -> tab( N ), "If the ", literal( Result ), " then:", newline, explanation( Step, s(N) ) ). literal( 0 ) --> "0". literal( 1 ) --> "1". literal( 2 ) --> "2". literal( 3 ) --> "3". literal( 4 ) --> "4". literal( 5 ) --> "5". literal( 6 ) --> "6". literal( 7 ) --> "7". literal( 8 ) --> "8". literal( 9 ) --> "9". literal( 10 ) --> "10". literal( 11 ) --> "11". literal( 12 ) --> "12". literal( true ) --> "true". literal( heavy ) --> "heavy". literal( light ) --> "light". literal( = ) --> "pans balance". literal( < ) --> "right-hand pan is heavier". literal( > ) --> "left-hand pan is heavier". literal( Collection ) --> {collection_to_set( Collection , [H|T] )}, literal_set( T, H ). literal_set( [], Number ) --> "the coin numbered ", literal( Number ). literal_set( [H|T], Number ) --> "the coins numbered ", literal( Number ), literal_set1( T, H ). literal_set1( [], Number ) --> " and ", literal( Number ). literal_set1( [H|T], Number ) --> ", ", literal( Number ), literal_set1( T, H ). tab( 0 ) --> "". tab( s(N) ) --> " ", tab( N ). newline --> " ". </syntaxhighlight> ===Utility Predicates=== ====contains_coin( ?Collection, ?Coin )==== holds when <var>Coin</var> is a member of <var>Collection</var>. <syntaxhighlight lang="prolog"> contains_coin( Collection, Coin ) :- part( _Part, Collection, Coins ), member( Coin, Coins ). </syntaxhighlight> ====collection_to_set( +Collection, ?Set )==== holds when <var>Set</var> is the distributed union of the <code>known_true</code>, <code>not_heavy</code>, <code>not_light</code> and <code>untested</code> ordsets comprising <var>Collection</var>. <syntaxhighlight lang="prolog"> collection_to_set( Collection, Set ) :- part( known_true, Collection, KnownTrue ), part( not_heavy, Collection, NotHeavy ), part( not_light, Collection, NotLight ), part( untested, Collection, Untested ), ord_union( [KnownTrue,NotHeavy,NotLight,Untested], Set ). </syntaxhighlight> ==== information_content( +Counts, ?Content ) ==== holds when <var>Content</var> is the cumulative negative entropy of <var>Counts</var>. A reduction in entropy equates to a gain in information. <syntaxhighlight lang="prolog"> information_content( Counts, Content ) :- information_content1( Counts, 0, Content ). information_content1( [], Content, Content ). information_content1( [Count|Counts], Content0, Content ):- coins_entropy( Count, Entropy ), Content1 is Content0-Entropy, information_content1( Counts, Content1, Content ). </syntaxhighlight> ==== coins_entropy( ?N, ?Entropy ) ==== holds when <var>Entropy</var> estimates the entropy of a sample of <var>N</var> coins. <var>Entropy</var> = P log₂(1/P), where P = <var>N</var>/12. <syntaxhighlight lang="prolog"> coins_entropy( 0, 0.0 ). coins_entropy( 1, 0.2987 ). coins_entropy( 2, 0.4308 ). coins_entropy( 3, 0.5 ). coins_entropy( 4, 0.5283 ). coins_entropy( 5, 0.5263 ). coins_entropy( 6, 0.5 ). coins_entropy( 7, 0.4536 ). coins_entropy( 8, 0.39 ). coins_entropy( 9, 0.3113 ). coins_entropy( 10, 0.2192 ). coins_entropy( 11, 0.1151 ). coins_entropy( 12, 0.0 ). </syntaxhighlight> ====select_coins( +Part, +Coins, ?Sample, ?Residue, ?N )==== holds when <var>N</var> coins from <var>Part</var> of <var>Coins</var> form <var>Part</var> of <var>Sample</var>, with the remainder forming <var>Part</var> of <var>Residue</var>. <syntaxhighlight lang="prolog"> select_coins( Part, Coins, Sample, Residue, Count ) :- part( Part, Coins, Input ), part( Part, Sample, Selection ), part( Part, Residue, Remainder ), select_n( Count, Input, Selection, Remainder ). select_n( 0, In, [], In ). select_n( 1, [A|Suffix], [A], Suffix ). select_n( 2, [A,B|Suffix], [A,B], Suffix ). select_n( 3, [A,B,C|Suffix], [A,B,C], Suffix ). select_n( 4, [A,B,C,D|Suffix], [A,B,C,D], Suffix ). select_n( 5, [A,B,C,D,E|Suffix], [A,B,C,D,E], Suffix ). select_n( 6, [A,B,C,D,E,F|Suffix], [A,B,C,D,E,F], Suffix ). </syntaxhighlight> Load a small library of [[Puzzle Utilities]]. <syntaxhighlight lang="prolog"> :- ensure_loaded( misc ). </syntaxhighlight> Use the ordsets library. <syntaxhighlight lang="prolog"> :- use_module( library(ordsets), [ord_union/2,ord_union/3] ). </syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/download/counterfeit.txt here]. ==Output== <div class="result"> Number the coins 1..12 BEGIN Put the coins numbered 1, 2, 3 and 4 on the left-hand pan Put the coins numbered 5, 6, 7 and 8 on the right-hand pan Leaving the coins numbered 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 1, 2, 5 and 6 on the left-hand pan Put the coins numbered 3, 7, 9 and 10 on the right-hand pan Leaving the coins numbered 4, 8, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 1 and 7 on the left-hand pan Put the coins numbered 3 and 4 on the right-hand pan Leaving the coins numbered 2, 5, 6, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 1, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 7, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 2, which is light END If the left-hand pan is heavier then: BEGIN Put the coins numbered 3 and 5 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 4, 6, 7, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 3, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 5, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 6, which is heavy END If the pans balance then: BEGIN Put the coins numbered 4 and 8 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 3, 5, 6, 7, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 4, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 8, which is heavy END END If the left-hand pan is heavier then: BEGIN Put the coins numbered 1, 2, 5 and 6 on the left-hand pan Put the coins numbered 3, 7, 9 and 10 on the right-hand pan Leaving the coins numbered 4, 8, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 3 and 5 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 4, 6, 7, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 5, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 3, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 6, which is light END If the left-hand pan is heavier then: BEGIN Put the coins numbered 1 and 7 on the left-hand pan Put the coins numbered 3 and 4 on the right-hand pan Leaving the coins numbered 2, 5, 6, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 7, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 1, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 2, which is heavy END If the pans balance then: BEGIN Put the coins numbered 4 and 8 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 3, 5, 6, 7, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 8, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 4, which is heavy END END If the pans balance then: BEGIN Put the coins numbered 9, 10 and 11 on the left-hand pan Put the coins numbered 1, 2 and 3 on the right-hand pan Leaving the coins numbered 4, 5, 6, 7, 8 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coin numbered 9 on the left-hand pan Put the coin numbered 10 on the right-hand pan Leaving the coins numbered 1, 2, 3, 4, 5, 6, 7, 8, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 9, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 10, which is light If the pans balance then: Conclude that the counterfeit coin is number 11, which is light END If the left-hand pan is heavier then: BEGIN Put the coin numbered 9 on the left-hand pan Put the coin numbered 10 on the right-hand pan Leaving the coins numbered 1, 2, 3, 4, 5, 6, 7, 8, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 10, which is heavy If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 9, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 11, which is heavy END If the pans balance then: BEGIN Put the coin numbered 12 on the left-hand pan Put the coin numbered 1 on the right-hand pan Leaving the coins numbered 2, 3, 4, 5, 6, 7, 8, 9, 10 and 11 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 12, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 12, which is heavy END END END </div> ---- 3fe6ed4c09213e052887f02775eb1ddcc747e28a 51 48 2013-11-01T21:11:23Z John 2 /* draw_inferences( +Result, +Left, +Right, +Table, ?Coins ) */ wikitext text/x-wiki __NOTOC__ ==Problem Definition== We are given 12 apparently identical coins - one of which is counterfeit. We know that the counterfeit has a different weight from the others, but we don't know if it's heavier or lighter. ===Task:=== Devise a procedure to identify any counterfeit coin using a balance to take up to three comparative weighings. ==Strategy== The information from three suitable weighings will make all but one of the 'coins', which are untested initially, 'known true'. There are three alternative deductions that make a coin 'known true': * if it is 'not heavy' and 'not light' - having been on both the comparatively lighter and heavier sides of imbalances; * if it was excluded from an imbalance; * if it was included in a balanced weighing. After three weighings there must be exactly one coin, the counterfeit, which is not 'true'. If the counterfeit is not true and 'not heavy' we deduce that it must be light. If it is not true and 'not light', it must be heavy. We use a 'generate-and-test' method as follows: * Create the set of all possible 'counterfeits': 12 coins &times; 2 weights ; * Devise a procedure that can identify the first counterfeit coin; * Show that the same procedure works for every other counterfeit. ==Entry Point== ====go==== is the entry point. It solves the puzzle, then uses a DCG to pretty-print the resulting procedure. <syntaxhighlight lang="prolog"> go :- coins_puzzle( Procedure ), phrase( general_explanation( Procedure ), Chars ), put_chars( Chars ). </syntaxhighlight> ====coins_puzzle( ?Procedure )==== generates the set of all possible 'counterfeits' and finds (or proves) that <var>Procedure</var> can identify them all. <syntaxhighlight lang="prolog"> coins_puzzle( Procedure ) :- coins( Coins ), counterfeit( Counterfeit, Coin, Weight ), findall( Counterfeit, (member(Coin,Coins), counterfeit_weight(Weight)), Counterfeits ), coins_puzzle_solution( Counterfeits, Procedure ). coins_puzzle_solution( [], _Procedure ). coins_puzzle_solution( [Counterfeit|Counterfeits], Procedure ) :- solve_coins( Counterfeit, Procedure ), coins_puzzle_solution( Counterfeits, Procedure ). </syntaxhighlight> A procedure is either 'done', identifying a particular coin and whether it is 'heavy' or 'light'; or it is a 'step'. A step defines the coins to be placed on the <var>Left</var> and <var>Right</var> pans, with the residue remaining on the <var>Table</var>, and three <var>Branches</var>, one of which will be chosen depending on the outcome of the weighing. <syntaxhighlight lang="prolog"> step( step(Left,Right,Table,Branches), Left, Right, Table, Branches). </syntaxhighlight> The <var>Branches</var> are three procedures equating to: * > (left pan heavier), * < (right pan heavier) and * <nowiki>= (pans balance).</nowiki> <syntaxhighlight lang="prolog"> branch( >, branches(_Equal, GT, _LT), GT ). branch( <, branches(_Equal, _GT, LT), LT ). branch( =, branches(Equal, _GT, _LT), Equal ). </syntaxhighlight> The counterfeit is defined by its number and whether it is heavy or light. <syntaxhighlight lang="prolog"> counterfeit( counterfeit(Coin, HeavyOrLight), Coin, HeavyOrLight ). coins( [1,2,3,4,5,6,7,8,9,10,11,12] ). counterfeit_weight( heavy ). counterfeit_weight( light ). </syntaxhighlight> A 'coin collection' comprises four 'parts' (subsets): the <code>known_true</code>, <code>not_heavy</code>, <code>not_light</code> and <code>untested</code> sets of coins. <syntaxhighlight lang="prolog"> part( known_true, collection(Coins,_,_,_), Coins ). part( not_heavy, collection(_,Coins,_,_), Coins ). part( not_light, collection(_,_,Coins,_), Coins ). part( untested, collection(_,_,_,Coins), Coins ). </syntaxhighlight> ==Solution== ====solve_coins( +Counterfeit, ?Procedure )==== holds when <var>Procedure</var> can correctly identify the <var>Counterfeit</var> coin. Beginning with a 'start' collection, in which all the coins are untested, the <var>Procedure</var> comprises three 'steps'. For each step a 'weighing' is made and a 'branch' is made in the <var>Procedure</var>, depending on the result of the weighing. After three steps, the <var>Procedure</var> must have reached the 'end' condition. Finally, an assertion (redundant test) ensures that the <var>Procedure</var> has found the correct end condition. <syntaxhighlight lang="prolog"> solve_coins( Counterfeit, Procedure ) :- start( Coins0 ), assay( Counterfeit, Coins0, Procedure, Branch1, Coins1 ), assay( Counterfeit, Coins1, Branch1, Branch2, Coins2 ), assay( Counterfeit, Coins2, Branch2, done(Coin, HeavyOrLight), Coins3 ), end( Coins3, Coin, HeavyOrLight ), counterfeit( Counterfeit, Coin, HeavyOrLight ). start( Coins ) :- coins( Untested ), part( untested, Coins, Untested ), part( not_heavy, Coins, [] ), part( not_light, Coins, [] ), part( known_true, Coins, [] ). end( Coins, Coin, HeavyOrLight ) :- part( untested, Coins, [] ), part( not_heavy, Coins, Light ), part( not_light, Coins, Heavy ), end_result( Heavy, Light, Coin, HeavyOrLight ). end_result( [Coin], [], Coin, heavy ). end_result( [], [Coin], Coin, light ). </syntaxhighlight> === Simulating the weighing process === ====assay( +Counterfeit, +Coins0, ?Step, ?Branch, ?Coins1 )==== holds when the appropriate <var>Branch</var> from <var>Step</var> is chosen by comparing the weights of two coin collections taken from the full set of coins: <var>Coins0</var>. <var>Coins1</var> is the full set of coins, updated with the inferences drawn from the weighing. <var>Counterfeit</var> is used to determine the result of the weighing. This predicate applies the critical insight into the solution of this puzzle: we have 24 (12 &times; 2) possible inputs to the procedure, with only 27 (3 &times; 3 &times; 3) possible outcomes from the weighings. Therefore, it is clear that each weighing must have a very high 'information content'. Choosing which weighing to make by estimating the available information content makes the problem tractable. <syntaxhighlight lang="prolog"> assay( Counterfeit, Coins0, Step, Branch, Coins ) :- WeighingDatum = weighing_data(InfoContent, Left, Right, Table), step( Step, Left, Right, Table, Branches ), findall( WeighingDatum, valid_partition( Coins0, InfoContent, Left, Right, Table ), WeighingData ), sort( WeighingData, OrderedWeighingData ), member( WeighingDatum, OrderedWeighingData ), balance( Left, Right, Counterfeit, Result ), draw_inferences( Result, Left, Right, Table, Coins ), branch( Result, Branches, Branch ). </syntaxhighlight> ====balance( +Left, +Right, +Counterfeit, ?Result )==== holds when <var>Result</var> simulates the outcome of testing the coin collections <var>Left</var> and <var>Right</var> with a balance, where either may contain the <var>Counterfeit</var> coin. <syntaxhighlight lang="prolog"> balance( Left, Right, Counterfeit, Result ):- counterfeit( Counterfeit, Coin, Weight ), ( contains_coin( Left, Coin ) -> balance_result( Weight, normal, Result ) ; contains_coin( Right, Coin ) -> balance_result( normal, Weight, Result ) ; otherwise -> Result = '=' ). balance_result( light, normal, < ). balance_result( heavy, normal, > ). balance_result( normal, heavy, < ). balance_result( normal, light, > ). </syntaxhighlight> ===Choosing which coins to weigh=== ====valid_partition( +Coins, ?Content, ?Left, ?Right, ?Table )==== holds when <var>Coins</var> can be partitioned into three collections: <var>Left</var> side, <var>Right</var> side and <var>Table</var>; with the 'information content' of the partition given by <var>Content</var>. The definition of a 'valid partition' ensures that: * <var>Left</var> and <var>Right</var> must have the same number of coins (at least one); * <var>Left</var> cannot contain any known 'true' coins, because adding true coins to both sides creates redundant comparisons. A 'checksum' is used to ensure that only one member of each pair of symmetrical solutions can be generated. <syntaxhighlight lang="prolog"> valid_partition( Coins, Content, Left, Right, Table ):- part( known_true, Left, [] ), selection( Coins, Left, Coins1, Count, LeftChecksum, LeftInfo ), Count >= 1, selection( Coins1, Right, Table, Count, RightChecksum, RightInfo ), LeftChecksum =< RightChecksum, % Checksum to prevent symmetrical solutions table_information( Table, TableInfo ), sum( [LeftInfo,RightInfo,TableInfo], Content ). </syntaxhighlight> ====selection( +Coins, ?Sample, ?Residue, ?Count, ?Checksum, ?Content )==== holds when <var>Coins</var> is partitioned into two collections: <var>Sample</var> and <var>Residue</var>. <var>Count</var> is the number of coins in <var>Sample</var>. <var>Checksum</var> is a fingerprint for the mixture of coins in <var>Sample</var>, which has 'information content' <var>Content</var>. <syntaxhighlight lang="prolog"> selection( Coins, Sample, Residue, Count, Checksum, Content ) :- select_coins( not_heavy, Coins, Sample, Residue, Count1 ), select_coins( not_light, Coins, Sample, Residue, Count2 ), select_coins( untested, Coins, Sample, Residue, Count3 ), select_coins( known_true, Coins, Sample, Residue, Count4 ), Count is Count1+Count2+Count3+Count4, Count =< 6, Checksum is Count1+(7*Count2)+(43*Count3)+(259*Count4), information_content( [Count1,Count2,Count3,Count4], Content ). </syntaxhighlight> ====table_information( +Coins, ?Content )==== holds when <var>Coins</var> has 'information content' <var>Content</var>. <syntaxhighlight lang="prolog"> table_information( Coins, Content ) :- count_coins( not_heavy, Coins, Count1 ), count_coins( not_light, Coins, Count2 ), count_coins( untested, Coins, Count3 ), count_coins( known_true, Coins, Count4 ), information_content( [Count1,Count2,Count3,Count4], Content ). count_coins( Part, Coins, Count ) :- part( Part, Coins, Selection ), length( Selection, Count ). </syntaxhighlight> === Updating what is known about the coins === ====draw_inferences( +Result, +Left, +Right, +Table, ?Coins )==== holds when <var>Result</var> is one of: * > (imbalance - left pan heavier), * < (imbalance - right pan heavier) or * <nowiki>=</nowiki> (pans balanced) from taking a weighing with the coin collections: <var>Left</var>, <var>Right</var> and <var>Table</var>. <var>Coins</var> is derived from this information using the following rules: * If the pans are unbalanced then only the previously untested or not_heavy coins on the lighter side of the balance are now not_heavy. Similarly, only the previously untested or not_light coins on the heavier side of the balance are now not_light. All the coins on the table are now known_true. * If the pans balance then all the coins weighed are known_true, with the coins on the <var>Table</var> left in their prior states. <syntaxhighlight lang="prolog"> draw_inferences( <, Left, Right, Table, Coins ) :- imbalance_inferences( Left, Right, Table, Coins ). draw_inferences( >, Left, Right, Table, Coins ) :- imbalance_inferences( Right, Left, Table, Coins ). draw_inferences( =, Left, Right, Table, Coins ) :- becomes( [all(Left),known_true(Table),all(Right)], known_true( Coins ) ), becomes( untested(Table), untested(Coins) ), becomes( not_heavy(Table), not_heavy(Coins) ), becomes( not_light(Table), not_light(Coins) ). </syntaxhighlight> ====imbalance_inferences( +Lighter, +Heavier, +Table, ?Coins )==== holds when: * All untested or not_heavy coins in <var>Lighter</var> are not_heavy in <var>Coins</var>; * All untested or not_light coins in <var>Heavier</var> are not_light in <var>Coins</var>; * All coins in <var>Table</var> are known_true in <var>Coins</var>; There are no untested coins in <var>Coins</var>. <syntaxhighlight lang="prolog"> imbalance_inferences( Lighter, Heavier, Table, Coins ) :- inference( [untested(Lighter),not_heavy(Lighter)], not_heavy(Coins) ), inference( [untested(Heavier),not_light(Heavier)], not_light(Coins) ), inference( [ known_true(Lighter), not_light(Lighter), known_true(Heavier), not_heavy(Heavier), all(Table) ], known_true(Coins) ), part( untested, Coins, [] ). </syntaxhighlight> ====inference( +CollectionA, ?CollectionB )==== holds when (part) <var>CollectionB</var> comprises the same coins as (part) <var>CollectionA</var>. <syntaxhighlight lang="prolog"> inference( CollectionA, CollectionB ) :- unfolded( CollectionA, Coins ), unfolded( CollectionB, Coins ). </syntaxhighlight> ====unfolded( +Collection, ?Coins )==== holds when (part) <var>Collection</var> comprises <var>Coins</var>. <syntaxhighlight lang="prolog"> unfolded( not_light(Collection), Coins ) :- part( not_light, Collection, Coins ). unfolded( not_heavy(Collection), Coins ) :- part( not_heavy, Collection, Coins ). unfolded( known_true(Collection), Coins ) :- part( known_true, Collection, Coins ). unfolded( untested(Collection), Coins ) :- part( untested, Collection, Coins ). unfolded( all(Collection), Coins ) :- collection_to_set( Collection, Coins ). unfolded( [Item|Items], Coins ) :- unfolded( Item, Value ), unfolded1( Items, Value, Coins ). unfolded1( [], Coins, Coins ). unfolded1( [Item|Items], Value, Coins ) :- unfolded( Item, Value0 ), ord_union( Value0, Value, Value1 ), unfolded1( Items, Value1, Coins ). </syntaxhighlight> ==Definite Clause Grammar== The following DCG represents the method for finding the counterfeit coin as a 'structured' procedure. <syntaxhighlight lang="prolog"> general_explanation( Procedure ) --> "Number the coins 1..12", newline, explanation( Procedure, 0 ). explanation( done(Coin, Weight), N ) --> tab( N ), "Conclude that the counterfeit coin is number ", literal( Coin ), ", which is ", literal( Weight ), newline. explanation( Step, N ) --> {step( Step, Left, Right, Table, Branches )}, tab( N ), "BEGIN", newline, tab( N ), "Put ", literal( Left ), " on the left-hand pan", newline, tab( N ), "Put ", literal( Right ), " on the right-hand pan", newline, tab( N ), "Leaving ", literal( Table ), " on the table", newline, branches_explained( Branches, N ), tab( N ), "END", newline. branches_explained( Branches, N ) --> next_step_explained( <, Branches, N ), next_step_explained( >, Branches, N ), next_step_explained( =, Branches, N ). next_step_explained( Result, Branch, N ) --> {branch( Result, Branch, Step )}, ( {var(Step)} -> "" | {nonvar(Step)} -> tab( N ), "If the ", literal( Result ), " then:", newline, explanation( Step, s(N) ) ). literal( 0 ) --> "0". literal( 1 ) --> "1". literal( 2 ) --> "2". literal( 3 ) --> "3". literal( 4 ) --> "4". literal( 5 ) --> "5". literal( 6 ) --> "6". literal( 7 ) --> "7". literal( 8 ) --> "8". literal( 9 ) --> "9". literal( 10 ) --> "10". literal( 11 ) --> "11". literal( 12 ) --> "12". literal( true ) --> "true". literal( heavy ) --> "heavy". literal( light ) --> "light". literal( = ) --> "pans balance". literal( < ) --> "right-hand pan is heavier". literal( > ) --> "left-hand pan is heavier". literal( Collection ) --> {collection_to_set( Collection , [H|T] )}, literal_set( T, H ). literal_set( [], Number ) --> "the coin numbered ", literal( Number ). literal_set( [H|T], Number ) --> "the coins numbered ", literal( Number ), literal_set1( T, H ). literal_set1( [], Number ) --> " and ", literal( Number ). literal_set1( [H|T], Number ) --> ", ", literal( Number ), literal_set1( T, H ). tab( 0 ) --> "". tab( s(N) ) --> " ", tab( N ). newline --> " ". </syntaxhighlight> ===Utility Predicates=== ====contains_coin( ?Collection, ?Coin )==== holds when <var>Coin</var> is a member of <var>Collection</var>. <syntaxhighlight lang="prolog"> contains_coin( Collection, Coin ) :- part( _Part, Collection, Coins ), member( Coin, Coins ). </syntaxhighlight> ====collection_to_set( +Collection, ?Set )==== holds when <var>Set</var> is the distributed union of the <code>known_true</code>, <code>not_heavy</code>, <code>not_light</code> and <code>untested</code> ordsets comprising <var>Collection</var>. <syntaxhighlight lang="prolog"> collection_to_set( Collection, Set ) :- part( known_true, Collection, KnownTrue ), part( not_heavy, Collection, NotHeavy ), part( not_light, Collection, NotLight ), part( untested, Collection, Untested ), ord_union( [KnownTrue,NotHeavy,NotLight,Untested], Set ). </syntaxhighlight> ==== information_content( +Counts, ?Content ) ==== holds when <var>Content</var> is the cumulative negative entropy of <var>Counts</var>. A reduction in entropy equates to a gain in information. <syntaxhighlight lang="prolog"> information_content( Counts, Content ) :- information_content1( Counts, 0, Content ). information_content1( [], Content, Content ). information_content1( [Count|Counts], Content0, Content ):- coins_entropy( Count, Entropy ), Content1 is Content0-Entropy, information_content1( Counts, Content1, Content ). </syntaxhighlight> ==== coins_entropy( ?N, ?Entropy ) ==== holds when <var>Entropy</var> estimates the entropy of a sample of <var>N</var> coins. <var>Entropy</var> = P log₂(1/P), where P = <var>N</var>/12. <syntaxhighlight lang="prolog"> coins_entropy( 0, 0.0 ). coins_entropy( 1, 0.2987 ). coins_entropy( 2, 0.4308 ). coins_entropy( 3, 0.5 ). coins_entropy( 4, 0.5283 ). coins_entropy( 5, 0.5263 ). coins_entropy( 6, 0.5 ). coins_entropy( 7, 0.4536 ). coins_entropy( 8, 0.39 ). coins_entropy( 9, 0.3113 ). coins_entropy( 10, 0.2192 ). coins_entropy( 11, 0.1151 ). coins_entropy( 12, 0.0 ). </syntaxhighlight> ====select_coins( +Part, +Coins, ?Sample, ?Residue, ?N )==== holds when <var>N</var> coins from <var>Part</var> of <var>Coins</var> form <var>Part</var> of <var>Sample</var>, with the remainder forming <var>Part</var> of <var>Residue</var>. <syntaxhighlight lang="prolog"> select_coins( Part, Coins, Sample, Residue, Count ) :- part( Part, Coins, Input ), part( Part, Sample, Selection ), part( Part, Residue, Remainder ), select_n( Count, Input, Selection, Remainder ). select_n( 0, In, [], In ). select_n( 1, [A|Suffix], [A], Suffix ). select_n( 2, [A,B|Suffix], [A,B], Suffix ). select_n( 3, [A,B,C|Suffix], [A,B,C], Suffix ). select_n( 4, [A,B,C,D|Suffix], [A,B,C,D], Suffix ). select_n( 5, [A,B,C,D,E|Suffix], [A,B,C,D,E], Suffix ). select_n( 6, [A,B,C,D,E,F|Suffix], [A,B,C,D,E,F], Suffix ). </syntaxhighlight> Load a small library of [[Puzzle Utilities]]. <syntaxhighlight lang="prolog"> :- ensure_loaded( misc ). </syntaxhighlight> Use the ordsets library. <syntaxhighlight lang="prolog"> :- use_module( library(ordsets), [ord_union/2,ord_union/3] ). </syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/download/counterfeit.txt here]. ==Output== <div class="result"> Number the coins 1..12 BEGIN Put the coins numbered 1, 2, 3 and 4 on the left-hand pan Put the coins numbered 5, 6, 7 and 8 on the right-hand pan Leaving the coins numbered 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 1, 2, 5 and 6 on the left-hand pan Put the coins numbered 3, 7, 9 and 10 on the right-hand pan Leaving the coins numbered 4, 8, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 1 and 7 on the left-hand pan Put the coins numbered 3 and 4 on the right-hand pan Leaving the coins numbered 2, 5, 6, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 1, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 7, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 2, which is light END If the left-hand pan is heavier then: BEGIN Put the coins numbered 3 and 5 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 4, 6, 7, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 3, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 5, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 6, which is heavy END If the pans balance then: BEGIN Put the coins numbered 4 and 8 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 3, 5, 6, 7, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 4, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 8, which is heavy END END If the left-hand pan is heavier then: BEGIN Put the coins numbered 1, 2, 5 and 6 on the left-hand pan Put the coins numbered 3, 7, 9 and 10 on the right-hand pan Leaving the coins numbered 4, 8, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 3 and 5 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 4, 6, 7, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 5, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 3, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 6, which is light END If the left-hand pan is heavier then: BEGIN Put the coins numbered 1 and 7 on the left-hand pan Put the coins numbered 3 and 4 on the right-hand pan Leaving the coins numbered 2, 5, 6, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 7, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 1, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 2, which is heavy END If the pans balance then: BEGIN Put the coins numbered 4 and 8 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 3, 5, 6, 7, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 8, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 4, which is heavy END END If the pans balance then: BEGIN Put the coins numbered 9, 10 and 11 on the left-hand pan Put the coins numbered 1, 2 and 3 on the right-hand pan Leaving the coins numbered 4, 5, 6, 7, 8 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coin numbered 9 on the left-hand pan Put the coin numbered 10 on the right-hand pan Leaving the coins numbered 1, 2, 3, 4, 5, 6, 7, 8, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 9, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 10, which is light If the pans balance then: Conclude that the counterfeit coin is number 11, which is light END If the left-hand pan is heavier then: BEGIN Put the coin numbered 9 on the left-hand pan Put the coin numbered 10 on the right-hand pan Leaving the coins numbered 1, 2, 3, 4, 5, 6, 7, 8, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 10, which is heavy If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 9, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 11, which is heavy END If the pans balance then: BEGIN Put the coin numbered 12 on the left-hand pan Put the coin numbered 1 on the right-hand pan Leaving the coins numbered 2, 3, 4, 5, 6, 7, 8, 9, 10 and 11 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 12, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 12, which is heavy END END END </div> ---- 353babddcf587fd6dababba69420ec9e80546834 0 3 3 2013-06-02T21:51:07Z John 2 Created page with ";John Fletcher's home on the Web __NOTOC__ "Prolog is more than a language - it is a way of living :-)" Bart Demoen ==Prolog== Ever since I first learned Prolog, more than 2..." wikitext text/x-wiki ;John Fletcher's home on the Web __NOTOC__ "Prolog is more than a language - it is a way of living :-)" Bart Demoen ==Prolog== Ever since I first learned Prolog, more than 20 years ago, it has been my preferred programming language. ===Why use Prolog?=== Prolog is a tool for solving problems, rather than producing "software products", and it will appeal to you if: * You want your programs to be readable, and have a close correspondence with their specifications; * Statements like <tt>x = x + 1</tt> offend your mathematical sensibility; * You like to develop programs incrementally - with an interactive top-level, interactive debugging, and the ability to test (execute) program fragments independently; * You want fewer lines of code and (therefore) fewer faults; * You prefer to work with a handful of big ideas, rather than a lot of small ones; If you want to find out about Prolog on the Web, start with the Frequently Asked Questions for comp.lang.prolog. Other useful links include: * [[Logic Programming and the Internet]]. Prolog is unequalled as a language for expressing queries and integrity constraints, and for processing text, which make it an excellent choice for Internet applications. * XML documents and Prolog terms have the same "tree" structure, which makes it easy to program with XML and Prolog. My free code for [[Parsing XML with Prolog]] makes it even easier. * Recommended [[Prolog programming books]]. * My solutions to some puzzles in Prolog: ** [[The Water Jugs Problem]], ** [[The Counterfeit Coin Puzzle]], ** [[Cheating Linguists?]], ** [[Mister X]], ** [[Zoom Tracks]], ** [[Whodunit?]] Although Prolog is regarded as a niche language, it's a very versatile language. I believe that the programming languages used in 2050 will owe more to Prolog than to any other language. a006706206e81420f0f79e5f207844b27c0bef93 4 3 2013-06-02T21:52:26Z John 2 John moved page [[TPL]] to [[This Prolog Life]]: Better Title wikitext text/x-wiki ;John Fletcher's home on the Web __NOTOC__ "Prolog is more than a language - it is a way of living :-)" Bart Demoen ==Prolog== Ever since I first learned Prolog, more than 20 years ago, it has been my preferred programming language. ===Why use Prolog?=== Prolog is a tool for solving problems, rather than producing "software products", and it will appeal to you if: * You want your programs to be readable, and have a close correspondence with their specifications; * Statements like <tt>x = x + 1</tt> offend your mathematical sensibility; * You like to develop programs incrementally - with an interactive top-level, interactive debugging, and the ability to test (execute) program fragments independently; * You want fewer lines of code and (therefore) fewer faults; * You prefer to work with a handful of big ideas, rather than a lot of small ones; If you want to find out about Prolog on the Web, start with the Frequently Asked Questions for comp.lang.prolog. Other useful links include: * [[Logic Programming and the Internet]]. Prolog is unequalled as a language for expressing queries and integrity constraints, and for processing text, which make it an excellent choice for Internet applications. * XML documents and Prolog terms have the same "tree" structure, which makes it easy to program with XML and Prolog. My free code for [[Parsing XML with Prolog]] makes it even easier. * Recommended [[Prolog programming books]]. * My solutions to some puzzles in Prolog: ** [[The Water Jugs Problem]], ** [[The Counterfeit Coin Puzzle]], ** [[Cheating Linguists?]], ** [[Mister X]], ** [[Zoom Tracks]], ** [[Whodunit?]] Although Prolog is regarded as a niche language, it's a very versatile language. I believe that the programming languages used in 2050 will owe more to Prolog than to any other language. a006706206e81420f0f79e5f207844b27c0bef93 9 4 2013-06-21T22:08:55Z John 2 wikitext text/x-wiki ;John Fletcher's home on the Web __NOTOC__ "Prolog is more than a language - it is a way of living :-)" Bart Demoen ==Prolog== Ever since I first learned Prolog, more than 20 years ago, it has been my preferred programming language. ===Why use Prolog?=== Prolog is a tool for solving problems, rather than producing "software products", and it will appeal to you if: * You want your programs to be readable, and have a close correspondence with their specifications; * Statements like <tt>x = x + 1</tt> offend your mathematical sensibility; * You like to develop programs incrementally - with an interactive top-level, interactive debugging, and the ability to test (execute) program fragments independently; * You want fewer lines of code and (therefore) fewer faults; * You prefer to work with a handful of big ideas, rather than a lot of small ones; If you want to find out about Prolog on the Web, start with the [http://www.logic.at/prolog/faq/faq.html Frequently Asked Questions] for [https://groups.google.com/forum/?fromgroups#!forum/comp.lang.prolog comp.lang.prolog]. Other useful links include: * [https://binding-time.co.uk/lp_internet.html Logic Programming and the Internet]. Prolog is unequalled as a language for expressing queries and integrity constraints, and for processing text, which make it an excellent choice for Internet applications. * XML documents and Prolog terms have the same "tree" structure, which makes it easy to program with XML and Prolog. My free code for [https://binding-time.co.uk/xmlpl.html Parsing XML with Prolog] makes it even easier. * Recommended [https://binding-time.co.uk/prolog_books.html Prolog programming books]. * My solutions to some puzzles in Prolog: ** [https://binding-time.co.uk/water_jugs.html The Water Jugs Problem], ** [[The Counterfeit Coin Puzzle]], ** [https://binding-time.co.uk/nut1.html Cheating Linguists?], ** [https://binding-time.co.uk/mister_x.html Mister X], ** [https://binding-time.co.uk/zoom_tracks.html Zoom Tracks], ** [https://binding-time.co.uk/whodunit.html Whodunit?] Although Prolog is regarded as a niche language, it's a very versatile language. I believe that the programming languages used in 2050 will owe more to Prolog than to any other language. 9b28ab63af4091e48c98c97d202757fd7be81bd6 17 9 2013-06-23T23:54:54Z John 2 wikitext text/x-wiki ;John Fletcher's home on the Web __NOTOC__ "Prolog is more than a language - it is a way of living :-)" Bart Demoen ==Prolog== Ever since I first learned Prolog, more than 20 years ago, it has been my preferred programming language. ===Why use Prolog?=== Prolog is a tool for solving problems, rather than producing "software products", and it will appeal to you if: * You want your programs to be readable, and have a close correspondence with their specifications; * Statements like x = x + 1 offend your mathematical sensibility; * You like to develop programs incrementally - with an interactive top-level, interactive debugging, and the ability to test (execute) program fragments independently; * You want fewer lines of code and (therefore) fewer faults; * You prefer to work with a handful of big ideas, rather than a lot of small ones; If you want to find out about Prolog on the Web, start with the [http://www.logic.at/prolog/faq/faq.html Frequently Asked Questions] for [https://groups.google.com/forum/?fromgroups#!forum/comp.lang.prolog comp.lang.prolog]. Other useful links include: * [https://binding-time.co.uk/lp_internet.html Logic Programming and the Internet]. Prolog is unequalled as a language for expressing queries and integrity constraints, and for processing text, which make it an excellent choice for Internet applications. * XML documents and Prolog terms have the same "tree" structure, which makes it easy to program with XML and Prolog. My free code for [https://binding-time.co.uk/xmlpl.html Parsing XML with Prolog] makes it even easier. * Recommended [https://binding-time.co.uk/prolog_books.html Prolog programming books]. * My solutions to some puzzles in Prolog: ** [https://binding-time.co.uk/water_jugs.html The Water Jugs Problem], ** [[The Counterfeit Coin Puzzle]], ** [https://binding-time.co.uk/nut1.html Cheating Linguists?], ** [https://binding-time.co.uk/mister_x.html Mister X], ** [https://binding-time.co.uk/zoom_tracks.html Zoom Tracks], ** [https://binding-time.co.uk/whodunit.html Whodunit?] Although Prolog is regarded as a niche language, it's a very versatile language. I believe that the programming languages used in 2050 will owe more to Prolog than to any other language. 42f4f51e5d8a05b72ed5443a309eb88c0d1024ae 25 17 2013-09-15T13:26:23Z John 2 /* Why use Prolog? */ wikitext text/x-wiki ;John Fletcher's home on the Web __NOTOC__ "Prolog is more than a language - it is a way of living :-)" Bart Demoen ==Prolog== Ever since I first learned Prolog, more than 20 years ago, it has been my preferred programming language. ===Why use Prolog?=== Prolog is a tool for solving problems, rather than producing "software products", and it will appeal to you if: * You want your programs to be readable, and have a close correspondence with their specifications; * Statements like x = x + 1 offend your mathematical sensibility; * You like to develop programs incrementally - with an interactive top-level, interactive debugging, and the ability to test (execute) program fragments independently; * You want fewer lines of code and (therefore) fewer faults; * You prefer to work with a handful of big ideas, rather than a lot of small ones; If you want to find out about Prolog on the Web, start with the [http://www.logic.at/prolog/faq/faq.html Frequently Asked Questions] for [https://groups.google.com/forum/?fromgroups#!forum/comp.lang.prolog comp.lang.prolog]. Other useful links include: * [https://binding-time.co.uk/lp_internet.html Logic Programming and the Internet]. Prolog is unequalled as a language for expressing queries and integrity constraints, and for processing text, which make it an excellent choice for Internet applications. * XML documents and Prolog terms have the same "tree" structure, which makes it easy to program with XML and Prolog. My free code for [https://binding-time.co.uk/xmlpl.html Parsing XML with Prolog] makes it even easier. * Recommended [https://binding-time.co.uk/prolog_books.html Prolog programming books]. * My solutions to some puzzles in Prolog: ** [The Water Jugs Problem], ** [[The Counterfeit Coin Puzzle]], ** [https://binding-time.co.uk/nut1.html Cheating Linguists?], ** [https://binding-time.co.uk/mister_x.html Mister X], ** [https://binding-time.co.uk/zoom_tracks.html Zoom Tracks], ** [https://binding-time.co.uk/whodunit.html Whodunit?] Although Prolog is regarded as a niche language, it's a very versatile language. I believe that the programming languages used in 2050 will owe more to Prolog than to any other language. 3c71576b58aed00297fd2825aa867a52d4646b24 26 25 2013-09-15T13:26:47Z John 2 /* Why use Prolog? */ wikitext text/x-wiki ;John Fletcher's home on the Web __NOTOC__ "Prolog is more than a language - it is a way of living :-)" Bart Demoen ==Prolog== Ever since I first learned Prolog, more than 20 years ago, it has been my preferred programming language. ===Why use Prolog?=== Prolog is a tool for solving problems, rather than producing "software products", and it will appeal to you if: * You want your programs to be readable, and have a close correspondence with their specifications; * Statements like x = x + 1 offend your mathematical sensibility; * You like to develop programs incrementally - with an interactive top-level, interactive debugging, and the ability to test (execute) program fragments independently; * You want fewer lines of code and (therefore) fewer faults; * You prefer to work with a handful of big ideas, rather than a lot of small ones; If you want to find out about Prolog on the Web, start with the [http://www.logic.at/prolog/faq/faq.html Frequently Asked Questions] for [https://groups.google.com/forum/?fromgroups#!forum/comp.lang.prolog comp.lang.prolog]. Other useful links include: * [https://binding-time.co.uk/lp_internet.html Logic Programming and the Internet]. Prolog is unequalled as a language for expressing queries and integrity constraints, and for processing text, which make it an excellent choice for Internet applications. * XML documents and Prolog terms have the same "tree" structure, which makes it easy to program with XML and Prolog. My free code for [https://binding-time.co.uk/xmlpl.html Parsing XML with Prolog] makes it even easier. * Recommended [https://binding-time.co.uk/prolog_books.html Prolog programming books]. * My solutions to some puzzles in Prolog: ** [[The Water Jugs Problem]], ** [[The Counterfeit Coin Puzzle]], ** [https://binding-time.co.uk/nut1.html Cheating Linguists?], ** [https://binding-time.co.uk/mister_x.html Mister X], ** [https://binding-time.co.uk/zoom_tracks.html Zoom Tracks], ** [https://binding-time.co.uk/whodunit.html Whodunit?] Although Prolog is regarded as a niche language, it's a very versatile language. I believe that the programming languages used in 2050 will owe more to Prolog than to any other language. fc41a0a3c7e40fad4241c622b24ce15d210ff3be 34 26 2013-10-13T21:50:42Z John 2 /* Why use Prolog? */ wikitext text/x-wiki ;John Fletcher's home on the Web __NOTOC__ "Prolog is more than a language - it is a way of living :-)" Bart Demoen ==Prolog== Ever since I first learned Prolog, more than 20 years ago, it has been my preferred programming language. ===Why use Prolog?=== Prolog is a tool for solving problems, rather than producing "software products", and it will appeal to you if: * You want your programs to be readable, and have a close correspondence with their specifications; * Statements like x = x + 1 offend your mathematical sensibility; * You like to develop programs incrementally - with an interactive top-level, interactive debugging, and the ability to test (execute) program fragments independently; * You want fewer lines of code and (therefore) fewer faults; * You prefer to work with a handful of big ideas, rather than a lot of small ones; If you want to find out about Prolog on the Web, start with the [http://www.logic.at/prolog/faq/faq.html Frequently Asked Questions] for [https://groups.google.com/forum/?fromgroups#!forum/comp.lang.prolog comp.lang.prolog]. Other useful links include: * [https://binding-time.co.uk/lp_internet.html Logic Programming and the Internet]. Prolog is unequalled as a language for expressing queries and integrity constraints, and for processing text, which make it an excellent choice for Internet applications. * XML documents and Prolog terms have the same "tree" structure, which makes it easy to program with XML and Prolog. My free code for [https://binding-time.co.uk/xmlpl.html Parsing XML with Prolog] makes it even easier. * Recommended [https://binding-time.co.uk/prolog_books.html Prolog programming books]. * My solutions to some puzzles in Prolog: ** [[The Water Jugs Problem]], ** [[The Counterfeit Coin Puzzle]], ** [[Cheating Linguists?]], ** [https://binding-time.co.uk/mister_x.html Mister X], ** [https://binding-time.co.uk/zoom_tracks.html Zoom Tracks], ** [https://binding-time.co.uk/whodunit.html Whodunit?] Although Prolog is regarded as a niche language, it's a very versatile language. I believe that the programming languages used in 2050 will owe more to Prolog than to any other language. 7911866dddba039e47a4a141a10cac4982b4a0f4 38 34 2013-10-13T22:08:36Z John 2 /* Why use Prolog? */ wikitext text/x-wiki ;John Fletcher's home on the Web __NOTOC__ "Prolog is more than a language - it is a way of living :-)" Bart Demoen ==Prolog== Ever since I first learned Prolog, more than 20 years ago, it has been my preferred programming language. ===Why use Prolog?=== Prolog is a tool for solving problems, rather than producing "software products", and it will appeal to you if: * You want your programs to be readable, and have a close correspondence with their specifications; * Statements like x = x + 1 offend your mathematical sensibility; * You like to develop programs incrementally - with an interactive top-level, interactive debugging, and the ability to test (execute) program fragments independently; * You want fewer lines of code and (therefore) fewer faults; * You prefer to work with a handful of big ideas, rather than a lot of small ones; If you want to find out about Prolog on the Web, start with the [http://www.logic.at/prolog/faq/faq.html Frequently Asked Questions] for [https://groups.google.com/forum/?fromgroups#!forum/comp.lang.prolog comp.lang.prolog]. Other useful links include: * [https://binding-time.co.uk/lp_internet.html Logic Programming and the Internet]. Prolog is unequalled as a language for expressing queries and integrity constraints, and for processing text, which make it an excellent choice for Internet applications. * XML documents and Prolog terms have the same "tree" structure, which makes it easy to program with XML and Prolog. My free code for [https://binding-time.co.uk/xmlpl.html Parsing XML with Prolog] makes it even easier. * Recommended [https://binding-time.co.uk/prolog_books.html Prolog programming books]. * My solutions to some puzzles in Prolog: ** [[The Water Jugs Problem]], ** [[The Counterfeit Coin Puzzle]], ** [[Cheating Linguists]]?, ** [https://binding-time.co.uk/mister_x.html Mister X], ** [https://binding-time.co.uk/zoom_tracks.html Zoom Tracks], ** [https://binding-time.co.uk/whodunit.html Whodunit?] Although Prolog is regarded as a niche language, it's a very versatile language. I believe that the programming languages used in 2050 will owe more to Prolog than to any other language. 6e2431982aa5b027eebab1aab016ca04df5b7f59 0 4 5 2013-06-02T21:52:26Z John 2 John moved page [[TPL]] to [[This Prolog Life]]: Better Title wikitext text/x-wiki #REDIRECT [[This Prolog Life]] 21c4b8c8d7fe5867360decd7112955079d60bdeb 8 5 6 2013-06-06T22:17:46Z WikiSysop 1 Created page with "This Prolog Life" wikitext text/x-wiki This Prolog Life 98b5b7f8561f67818c7efedb0da84b365e361129 8 6 7 2013-06-06T22:19:55Z WikiSysop 1 Created page with " * navigation ** mainpage|mainpage-description ** randompage-url|randompage ** helppage|help * SEARCH * TOOLBOX * LANGUAGES" wikitext text/x-wiki * navigation ** mainpage|mainpage-description ** randompage-url|randompage ** helppage|help * SEARCH * TOOLBOX * LANGUAGES ee131527ad5d1e73efbeacf52dddc319eee7eaab 8 7 2013-06-06T22:28:22Z WikiSysop 1 wikitext text/x-wiki * navigation ** mainpage|mainpage-description ** randompage-url|randompage ** helppage|help * SEARCH 98849b849b09b4baaad210a9fa8832247b06ecd1 4 7 10 2013-06-21T22:11:08Z John 2 Created page with "I am migrating my site to MediaWiki to make it easier to maintain." wikitext text/x-wiki I am migrating my site to MediaWiki to make it easier to maintain. 5c52b19aff5e8edd2d896c4f81111b3d076d38d0 11 10 2013-06-21T22:12:33Z John 2 wikitext text/x-wiki I am migrating my site to MediaWiki to make it easier to maintain. I hope that you like it. 9ac5ff3a491ffdc15a2e7ae4c6f8787cf5ad3675 16 11 2013-06-23T14:43:33Z John 2 wikitext text/x-wiki I am migrating my site to MediaWiki to make it easier to maintain. I hope that you like it. == Why Wiki? == MediaWiki makes it easy to incorporate computer code in web pages. Other sorts of markup can be generated automatically: <blockquote> <cite>From: [http://upload.wikimedia.org/wikipedia/wikimania2006/b/b5/CS1_slides.pdf What You See Is Wiki &mdash; Questioning WYSIWYG in the Internet age]</cite> ===The Documents Essence=== * Brooks Prediction 1986: "We will not see advances of scale in programming until we separate accidental tasks from essential tasks." * Transferring this to web authoring: ** Accidental Task: Formatting Layout ** Essential Task: Information + Basic Structure (Emphasis & Linking) * Wiki Markup is part of the essence of a document – teach the public! </blockquote> and <blockquote> "Features like site maps , breadcrumbs , and other structural elements must become browser commands. Extracting information space navigation from the website will liberate users from the whims of Web designers and ensure consistent and standardized navigation features. The Web's history has shown that people use generic commands like the Back button far more than intermittent features, which, when they are available -- and users can actually find them -- tend to look and work differently on different sites." <cite>From [http://www.nngroup.com/articles/time-to-make-tech-work/ Time to Make Tech Work Jakob Nielsen's Alertbox: September 15, 2003]</cite> </blockquote> 6c6c40b395d98522713b447d1ad4c0090979b539 0 8 27 2013-09-15T13:28:21Z John 2 Created page with "__NOTOC__ This classic AI problem is described in ''Artificial Intelligence'' as follows: <blockquote> "You are given two jugs, a 4-gallon one and a 3-gallon one. Neither has..." wikitext text/x-wiki __NOTOC__ This classic AI problem is described in ''Artificial Intelligence'' as follows: <blockquote> "You are given two jugs, a 4-gallon one and a 3-gallon one. Neither has any measuring markers on it. There is a tap that can be used to fill the jugs with water. How can you get exactly 2 gallons of water into the 4-gallon jug?". <cite>[http://www.amazon.co.uk/exec/obidos/ASIN/0070522634/bindingtimeli-21 E. Rich & K. Knight, Artificial Intelligence, 2nd edition, McGraw-Hill, 1991]</cite> </blockquote> This program implements an "environmentally responsible" solution to the ''water jugs'' problem. Rather than filling and spilling from an infinite water resource, we conserve a finite initial charge with a third jug: (reservoir). This approach is simpler than the traditional method, because there are only two actions; it is more flexible than the traditional method, because it can solve problems that are constrained by a limited supply from the reservoir. To simulate the infinite version, we use a filled reservoir with a capacity greater than the combined capacities of the jugs, so that the reservoir can never be emptied. <blockquote> "Perfection is achieved not when there is nothing more to add, but when there is nothing more to take away." <cite>[http://en.wikiquote.org/wiki/Antoine_de_Saint-Exupery Antoine de Saint-Exup&#233;ry]</cite> </blockquote> ==Solution== ====water_jugs==== is the entry point. The solution is derived by a simple, breadth-first, state-space search; and translated into a readable format by a DCG. <syntaxhighlight lang="prolog">water_jugs :- SmallCapacity = 3, LargeCapacity = 4, Reservoir is SmallCapacity + LargeCapacity + 1, volume( small, Capacities, SmallCapacity ), volume( large, Capacities, LargeCapacity ), volume( reservoir, Capacities, Reservoir ), volume( small, Start, 0 ), volume( large, Start, 0 ), volume( reservoir, Start, Reservoir ), volume( large, End, 2 ), water_jugs_solution( Start, Capacities, End, Solution ), phrase( narrative(Solution, Capacities, End), Chars ), put_chars( Chars ).</syntaxhighlight> ====water_jugs_solution( +Start, +Capacities, +End, ?Solution )==== holds when <var>Solution</var> is the terminal 'node' in a state-space search - beginning with a 'start state' in which the water-jugs have <var>Capacities</var> and contain the <var>Start</var> volumes. The terminal node is reached when the water-jugs contain the <var>End</var> volumes. <syntaxhighlight lang="prolog"> water_jugs_solution( Start, Capacities, End, Solution ) :- solve_jugs( [start(Start)], Capacities, [], End, Solution ). </syntaxhighlight> ====solve_jugs( +Nodes, +Capacities, +Visited, +End, ?Solution )==== holds when <var>Solution</var> is the terminal 'node' in a state-space search, beginning with a first 'open' node in <var>Nodes</var>, and terminating when the water-jugs contain the <var>End</var> volumes. <var>Capacities</var> define the capacities of the water-jugs, while <var>Visited</var> is a list of expanded ('closed') node states. The 'breadth-first' operation of solve_jugs is due to the 'existing' <var> Nodes</var> being appended to the 'new' nodes. (If the 'new' nodes were appended to the 'existing' nodes, the operation would be 'depth-first'.) <syntaxhighlight lang="prolog"> solve_jugs( [Node|Nodes], Capacities, Visited, End, Solution ) :- node_state( Node, State ), ( State = End -> Solution = Node ; otherwise -> findall( Successor, successor(Node, Capacities, Visited, Successor), Successors ), append( Nodes, Successors, NewNodes ), solve_jugs( NewNodes, Capacities, [State|Visited], End, Solution ) ). </syntaxhighlight> ====successor( +Node, +Capacities, +Visited, ?Successor )==== <var>Successor</var> is a successor of <var>Node</var>, for water-jugs with <var>Capacities</var>, if there is a legal 'transition' from <var> Node</var>'s state to <var>Successor</var>'s state, and <var>Successor</var>'s state is not a member of the <var>Visited</var> states. <syntaxhighlight lang="prolog"> successor( Node, Capacities, Visited, Successor ) :- node_state( Node, State ), Successor = node(Action,State1,Node), jug_transition( State, Capacities, Action, State1 ), \+ member( State1, Visited ). </syntaxhighlight> ===Transition Rules=== ====jug_transition( +State, +Capacities, ?Action, ?SuccessorState )==== holds when <var>Action</var> describes a valid transition, from <var>State</var> to <var>SuccessorState</var>, for water-jugs with <var>Capacities</var>. There are two sorts of <var>Action</var>: * <code>empty_into(Source,Target)</code> valid if <var>Source</var> is not already empty and the combined contents from <var>Source</var> and <var> Target</var>, (in <var>State</var>), are not greater than the capacity of the <var> Target</var> jug. In <var>SuccessorState</var>: <var>Source</var> becomes empty, while the <var>Target</var> jug acquires the combined contents of <var>Source</var> and <var>Target</var> in <var>State</var>. * <code>fill_from(Source,Target)</code> valid if <var>Source</var> is not already empty and the combined contents from <var>Source</var> and <var> Target</var>, (in <var>State</var>), are greater than the capacity of the <var> Target</var> jug. In <var> SuccessorState</var>: the <var>Target</var> jug becomes full, while <var>Source</var> retains the difference between the combined contents of <var>Source</var> and <var>Target</var>, in <var>State</var>, and the capacity of the <var>Target</var> jug. In either case, the contents of the unused jug are unchanged. <syntaxhighlight lang="prolog">jug_transition( State0, Capacities, empty_into(Source,Target), State1 ) :- volume( Source, State0, Content0 ), Content0 > 0, jug_permutation( Source, Target, Unused ), volume( Target, State0, Content1 ), volume( Target, Capacities, Capacity ), Content0 + Content1 =< Capacity, volume( Source, State1, 0 ), volume( Target, State1, Content2 ), Content2 is Content0 + Content1, volume( Unused, State0, Unchanged ), volume( Unused, State1, Unchanged ). jug_transition( State0, Capacities, fill_from(Source,Target), State1 ) :- volume( Source, State0, Content0 ), Content0 > 0, jug_permutation( Source, Target, Unused ), volume( Target, State0, Content1 ), volume( Target, Capacities, Capacity ), Content1 < Capacity, Content0 + Content1 > Capacity, volume( Source, State1, Content2 ), volume( Target, State1, Capacity ), Content2 is Content0 + Content1 - Capacity, volume( Unused, State0, Unchanged ), volume( Unused, State1, Unchanged ).</syntaxhighlight> ==Data Abstraction== ====volume( ?Jug, ?State, ?Volume )==== holds when <var>Jug</var> ('large', 'small' or 'reservoir') has <var>Volume</var> in <var>State</var>. <syntaxhighlight lang="prolog"> volume( small, jugs(Small, _Large, _Reservoir), Small ). volume( large, jugs(_Small, Large, _Reservoir), Large ). volume( reservoir, jugs(_Small, _Large, Reservoir), Reservoir ). </syntaxhighlight> ====jug_permutation( ?Source, ?Target, ?Unused )==== holds when <var>Source</var>, <var>Target</var> and <var>Unused</var> are a permutation of 'small', 'large' and 'reservoir'. <syntaxhighlight lang="prolog"> jug_permutation( Source, Target, Unused ) :- select( Source, [small, large, reservoir], Residue ), select( Target, Residue, [Unused] ). </syntaxhighlight> ====node_state( ?Node, ?State )==== holds when the contents of the water-jugs at <var>Node</var> are described by <var>State</var>. <syntaxhighlight lang="prolog"> node_state( start(State), State ). node_state( node(_Transition, State, _Predecessor), State ). </syntaxhighlight> ==Definite Clause Grammar== ====narrative/5==== is a DCG presenting water-jugs solutions in a readable format. The grammar is 'head-recursive', because the 'nodes list', describing the solution, has the last node outermost. <syntaxhighlight lang="prolog"> narrative( start(Start), Capacities, End ) --> "Given three jugs with capacities of:", newline, literal_volumes( Capacities ), "To obtain the result:", newline, literal_volumes( End ), "Starting with:", newline, literal_volumes( Start ), "Do the following:", newline. narrative( node(Transition, Result, Predecessor), Capacities, End ) --> narrative( Predecessor, Capacities, End ), literal_action( Transition, Result ). literal_volumes( Volumes ) --> indent, literal( Volumes ), ";", newline. literal_action( Transition, Result ) --> indent, "- ", literal( Transition ), " giving:", newline, indent, indent, literal( Result ), newline. literal( empty_into(From,To) ) --> "Empty the ", literal( From ), " into the ", literal( To ). literal( fill_from(From,To) ) --> "Fill the ", literal( To ), " from the ", literal( From ). literal( jugs(Small,Large,Reservoir) ) --> literal_number( Small ), " gallons in the small jug, ", literal_number( Large ), " gallons in the large jug and ", literal_number( Reservoir ), " gallons in the reservoir". literal( small ) --> "small jug". literal( large ) --> "large jug". literal( reservoir ) --> "reservoir". literal_number( Number, Plus, Minus ) :- number( Number ), number_chars( Number, Chars ), append( Chars, Minus, Plus ). indent --> " ". newline --> " ". </syntaxhighlight> ==Utility Predicates== Load a small library of [[Puzzle Utilities]]. <syntaxhighlight lang="prolog"> :- ensure_loaded( misc ). </syntaxhighlight> The code is available as plain text [http://www.binding-time/download/water_jugs.txt here]. ==Output== The output of the program is: <div class="result"> <pre> ?- water_jugs. Given three jugs with capacities of: 3 gallons in the small jug, 4 gallons in the large jug and 8 gallons in the reservoir; To obtain the result: 0 gallons in the small jug, 2 gallons in the large jug and 6 gallons in the reservoir; Starting with: 0 gallons in the small jug, 0 gallons in the large jug and 8 gallons in the reservoir; Do the following: - Fill the small jug from the reservoir giving: 3 gallons in the small jug, 0 gallons in the large jug and 5 gallons in the reservoir - Empty the small jug into the large jug giving: 0 gallons in the small jug, 3 gallons in the large jug and 5 gallons in the reservoir - Fill the small jug from the reservoir giving: 3 gallons in the small jug, 3 gallons in the large jug and 2 gallons in the reservoir - Fill the large jug from the small jug giving: 2 gallons in the small jug, 4 gallons in the large jug and 2 gallons in the reservoir - Empty the large jug into the reservoir giving: 2 gallons in the small jug, 0 gallons in the large jug and 6 gallons in the reservoir - Empty the small jug into the large jug giving: 0 gallons in the small jug, 2 gallons in the large jug and 6 gallons in the reservoir yes </pre> </div> 725d13ad683fb355e9629d9fae0a6a81eeedaa3a 28 27 2013-09-15T13:31:08Z John 2 /* Utility Predicates */ wikitext text/x-wiki __NOTOC__ This classic AI problem is described in ''Artificial Intelligence'' as follows: <blockquote> "You are given two jugs, a 4-gallon one and a 3-gallon one. Neither has any measuring markers on it. There is a tap that can be used to fill the jugs with water. How can you get exactly 2 gallons of water into the 4-gallon jug?". <cite>[http://www.amazon.co.uk/exec/obidos/ASIN/0070522634/bindingtimeli-21 E. Rich & K. Knight, Artificial Intelligence, 2nd edition, McGraw-Hill, 1991]</cite> </blockquote> This program implements an "environmentally responsible" solution to the ''water jugs'' problem. Rather than filling and spilling from an infinite water resource, we conserve a finite initial charge with a third jug: (reservoir). This approach is simpler than the traditional method, because there are only two actions; it is more flexible than the traditional method, because it can solve problems that are constrained by a limited supply from the reservoir. To simulate the infinite version, we use a filled reservoir with a capacity greater than the combined capacities of the jugs, so that the reservoir can never be emptied. <blockquote> "Perfection is achieved not when there is nothing more to add, but when there is nothing more to take away." <cite>[http://en.wikiquote.org/wiki/Antoine_de_Saint-Exupery Antoine de Saint-Exup&#233;ry]</cite> </blockquote> ==Solution== ====water_jugs==== is the entry point. The solution is derived by a simple, breadth-first, state-space search; and translated into a readable format by a DCG. <syntaxhighlight lang="prolog">water_jugs :- SmallCapacity = 3, LargeCapacity = 4, Reservoir is SmallCapacity + LargeCapacity + 1, volume( small, Capacities, SmallCapacity ), volume( large, Capacities, LargeCapacity ), volume( reservoir, Capacities, Reservoir ), volume( small, Start, 0 ), volume( large, Start, 0 ), volume( reservoir, Start, Reservoir ), volume( large, End, 2 ), water_jugs_solution( Start, Capacities, End, Solution ), phrase( narrative(Solution, Capacities, End), Chars ), put_chars( Chars ).</syntaxhighlight> ====water_jugs_solution( +Start, +Capacities, +End, ?Solution )==== holds when <var>Solution</var> is the terminal 'node' in a state-space search - beginning with a 'start state' in which the water-jugs have <var>Capacities</var> and contain the <var>Start</var> volumes. The terminal node is reached when the water-jugs contain the <var>End</var> volumes. <syntaxhighlight lang="prolog"> water_jugs_solution( Start, Capacities, End, Solution ) :- solve_jugs( [start(Start)], Capacities, [], End, Solution ). </syntaxhighlight> ====solve_jugs( +Nodes, +Capacities, +Visited, +End, ?Solution )==== holds when <var>Solution</var> is the terminal 'node' in a state-space search, beginning with a first 'open' node in <var>Nodes</var>, and terminating when the water-jugs contain the <var>End</var> volumes. <var>Capacities</var> define the capacities of the water-jugs, while <var>Visited</var> is a list of expanded ('closed') node states. The 'breadth-first' operation of solve_jugs is due to the 'existing' <var> Nodes</var> being appended to the 'new' nodes. (If the 'new' nodes were appended to the 'existing' nodes, the operation would be 'depth-first'.) <syntaxhighlight lang="prolog"> solve_jugs( [Node|Nodes], Capacities, Visited, End, Solution ) :- node_state( Node, State ), ( State = End -> Solution = Node ; otherwise -> findall( Successor, successor(Node, Capacities, Visited, Successor), Successors ), append( Nodes, Successors, NewNodes ), solve_jugs( NewNodes, Capacities, [State|Visited], End, Solution ) ). </syntaxhighlight> ====successor( +Node, +Capacities, +Visited, ?Successor )==== <var>Successor</var> is a successor of <var>Node</var>, for water-jugs with <var>Capacities</var>, if there is a legal 'transition' from <var> Node</var>'s state to <var>Successor</var>'s state, and <var>Successor</var>'s state is not a member of the <var>Visited</var> states. <syntaxhighlight lang="prolog"> successor( Node, Capacities, Visited, Successor ) :- node_state( Node, State ), Successor = node(Action,State1,Node), jug_transition( State, Capacities, Action, State1 ), \+ member( State1, Visited ). </syntaxhighlight> ===Transition Rules=== ====jug_transition( +State, +Capacities, ?Action, ?SuccessorState )==== holds when <var>Action</var> describes a valid transition, from <var>State</var> to <var>SuccessorState</var>, for water-jugs with <var>Capacities</var>. There are two sorts of <var>Action</var>: * <code>empty_into(Source,Target)</code> valid if <var>Source</var> is not already empty and the combined contents from <var>Source</var> and <var> Target</var>, (in <var>State</var>), are not greater than the capacity of the <var> Target</var> jug. In <var>SuccessorState</var>: <var>Source</var> becomes empty, while the <var>Target</var> jug acquires the combined contents of <var>Source</var> and <var>Target</var> in <var>State</var>. * <code>fill_from(Source,Target)</code> valid if <var>Source</var> is not already empty and the combined contents from <var>Source</var> and <var> Target</var>, (in <var>State</var>), are greater than the capacity of the <var> Target</var> jug. In <var> SuccessorState</var>: the <var>Target</var> jug becomes full, while <var>Source</var> retains the difference between the combined contents of <var>Source</var> and <var>Target</var>, in <var>State</var>, and the capacity of the <var>Target</var> jug. In either case, the contents of the unused jug are unchanged. <syntaxhighlight lang="prolog">jug_transition( State0, Capacities, empty_into(Source,Target), State1 ) :- volume( Source, State0, Content0 ), Content0 > 0, jug_permutation( Source, Target, Unused ), volume( Target, State0, Content1 ), volume( Target, Capacities, Capacity ), Content0 + Content1 =< Capacity, volume( Source, State1, 0 ), volume( Target, State1, Content2 ), Content2 is Content0 + Content1, volume( Unused, State0, Unchanged ), volume( Unused, State1, Unchanged ). jug_transition( State0, Capacities, fill_from(Source,Target), State1 ) :- volume( Source, State0, Content0 ), Content0 > 0, jug_permutation( Source, Target, Unused ), volume( Target, State0, Content1 ), volume( Target, Capacities, Capacity ), Content1 < Capacity, Content0 + Content1 > Capacity, volume( Source, State1, Content2 ), volume( Target, State1, Capacity ), Content2 is Content0 + Content1 - Capacity, volume( Unused, State0, Unchanged ), volume( Unused, State1, Unchanged ).</syntaxhighlight> ==Data Abstraction== ====volume( ?Jug, ?State, ?Volume )==== holds when <var>Jug</var> ('large', 'small' or 'reservoir') has <var>Volume</var> in <var>State</var>. <syntaxhighlight lang="prolog"> volume( small, jugs(Small, _Large, _Reservoir), Small ). volume( large, jugs(_Small, Large, _Reservoir), Large ). volume( reservoir, jugs(_Small, _Large, Reservoir), Reservoir ). </syntaxhighlight> ====jug_permutation( ?Source, ?Target, ?Unused )==== holds when <var>Source</var>, <var>Target</var> and <var>Unused</var> are a permutation of 'small', 'large' and 'reservoir'. <syntaxhighlight lang="prolog"> jug_permutation( Source, Target, Unused ) :- select( Source, [small, large, reservoir], Residue ), select( Target, Residue, [Unused] ). </syntaxhighlight> ====node_state( ?Node, ?State )==== holds when the contents of the water-jugs at <var>Node</var> are described by <var>State</var>. <syntaxhighlight lang="prolog"> node_state( start(State), State ). node_state( node(_Transition, State, _Predecessor), State ). </syntaxhighlight> ==Definite Clause Grammar== ====narrative/5==== is a DCG presenting water-jugs solutions in a readable format. The grammar is 'head-recursive', because the 'nodes list', describing the solution, has the last node outermost. <syntaxhighlight lang="prolog"> narrative( start(Start), Capacities, End ) --> "Given three jugs with capacities of:", newline, literal_volumes( Capacities ), "To obtain the result:", newline, literal_volumes( End ), "Starting with:", newline, literal_volumes( Start ), "Do the following:", newline. narrative( node(Transition, Result, Predecessor), Capacities, End ) --> narrative( Predecessor, Capacities, End ), literal_action( Transition, Result ). literal_volumes( Volumes ) --> indent, literal( Volumes ), ";", newline. literal_action( Transition, Result ) --> indent, "- ", literal( Transition ), " giving:", newline, indent, indent, literal( Result ), newline. literal( empty_into(From,To) ) --> "Empty the ", literal( From ), " into the ", literal( To ). literal( fill_from(From,To) ) --> "Fill the ", literal( To ), " from the ", literal( From ). literal( jugs(Small,Large,Reservoir) ) --> literal_number( Small ), " gallons in the small jug, ", literal_number( Large ), " gallons in the large jug and ", literal_number( Reservoir ), " gallons in the reservoir". literal( small ) --> "small jug". literal( large ) --> "large jug". literal( reservoir ) --> "reservoir". literal_number( Number, Plus, Minus ) :- number( Number ), number_chars( Number, Chars ), append( Chars, Minus, Plus ). indent --> " ". newline --> " ". </syntaxhighlight> ==Utility Predicates== Load a small library of [https://binding-time.co.uk/misc.html puzzle utilities]. <syntaxhighlight lang="prolog"> :- ensure_loaded( misc ). </syntaxhighlight> The code is available as plain text [http://www.binding-time/download/water_jugs.txt here]. ==Output== The output of the program is: <div class="result"> <pre> ?- water_jugs. Given three jugs with capacities of: 3 gallons in the small jug, 4 gallons in the large jug and 8 gallons in the reservoir; To obtain the result: 0 gallons in the small jug, 2 gallons in the large jug and 6 gallons in the reservoir; Starting with: 0 gallons in the small jug, 0 gallons in the large jug and 8 gallons in the reservoir; Do the following: - Fill the small jug from the reservoir giving: 3 gallons in the small jug, 0 gallons in the large jug and 5 gallons in the reservoir - Empty the small jug into the large jug giving: 0 gallons in the small jug, 3 gallons in the large jug and 5 gallons in the reservoir - Fill the small jug from the reservoir giving: 3 gallons in the small jug, 3 gallons in the large jug and 2 gallons in the reservoir - Fill the large jug from the small jug giving: 2 gallons in the small jug, 4 gallons in the large jug and 2 gallons in the reservoir - Empty the large jug into the reservoir giving: 2 gallons in the small jug, 0 gallons in the large jug and 6 gallons in the reservoir - Empty the small jug into the large jug giving: 0 gallons in the small jug, 2 gallons in the large jug and 6 gallons in the reservoir yes </pre> </div> ec26869742b8b4c8099f8c583a8eec2c4f4d51cf 29 28 2013-09-15T13:31:57Z John 2 /* Utility Predicates */ wikitext text/x-wiki __NOTOC__ This classic AI problem is described in ''Artificial Intelligence'' as follows: <blockquote> "You are given two jugs, a 4-gallon one and a 3-gallon one. Neither has any measuring markers on it. There is a tap that can be used to fill the jugs with water. How can you get exactly 2 gallons of water into the 4-gallon jug?". <cite>[http://www.amazon.co.uk/exec/obidos/ASIN/0070522634/bindingtimeli-21 E. Rich & K. Knight, Artificial Intelligence, 2nd edition, McGraw-Hill, 1991]</cite> </blockquote> This program implements an "environmentally responsible" solution to the ''water jugs'' problem. Rather than filling and spilling from an infinite water resource, we conserve a finite initial charge with a third jug: (reservoir). This approach is simpler than the traditional method, because there are only two actions; it is more flexible than the traditional method, because it can solve problems that are constrained by a limited supply from the reservoir. To simulate the infinite version, we use a filled reservoir with a capacity greater than the combined capacities of the jugs, so that the reservoir can never be emptied. <blockquote> "Perfection is achieved not when there is nothing more to add, but when there is nothing more to take away." <cite>[http://en.wikiquote.org/wiki/Antoine_de_Saint-Exupery Antoine de Saint-Exup&#233;ry]</cite> </blockquote> ==Solution== ====water_jugs==== is the entry point. The solution is derived by a simple, breadth-first, state-space search; and translated into a readable format by a DCG. <syntaxhighlight lang="prolog">water_jugs :- SmallCapacity = 3, LargeCapacity = 4, Reservoir is SmallCapacity + LargeCapacity + 1, volume( small, Capacities, SmallCapacity ), volume( large, Capacities, LargeCapacity ), volume( reservoir, Capacities, Reservoir ), volume( small, Start, 0 ), volume( large, Start, 0 ), volume( reservoir, Start, Reservoir ), volume( large, End, 2 ), water_jugs_solution( Start, Capacities, End, Solution ), phrase( narrative(Solution, Capacities, End), Chars ), put_chars( Chars ).</syntaxhighlight> ====water_jugs_solution( +Start, +Capacities, +End, ?Solution )==== holds when <var>Solution</var> is the terminal 'node' in a state-space search - beginning with a 'start state' in which the water-jugs have <var>Capacities</var> and contain the <var>Start</var> volumes. The terminal node is reached when the water-jugs contain the <var>End</var> volumes. <syntaxhighlight lang="prolog"> water_jugs_solution( Start, Capacities, End, Solution ) :- solve_jugs( [start(Start)], Capacities, [], End, Solution ). </syntaxhighlight> ====solve_jugs( +Nodes, +Capacities, +Visited, +End, ?Solution )==== holds when <var>Solution</var> is the terminal 'node' in a state-space search, beginning with a first 'open' node in <var>Nodes</var>, and terminating when the water-jugs contain the <var>End</var> volumes. <var>Capacities</var> define the capacities of the water-jugs, while <var>Visited</var> is a list of expanded ('closed') node states. The 'breadth-first' operation of solve_jugs is due to the 'existing' <var> Nodes</var> being appended to the 'new' nodes. (If the 'new' nodes were appended to the 'existing' nodes, the operation would be 'depth-first'.) <syntaxhighlight lang="prolog"> solve_jugs( [Node|Nodes], Capacities, Visited, End, Solution ) :- node_state( Node, State ), ( State = End -> Solution = Node ; otherwise -> findall( Successor, successor(Node, Capacities, Visited, Successor), Successors ), append( Nodes, Successors, NewNodes ), solve_jugs( NewNodes, Capacities, [State|Visited], End, Solution ) ). </syntaxhighlight> ====successor( +Node, +Capacities, +Visited, ?Successor )==== <var>Successor</var> is a successor of <var>Node</var>, for water-jugs with <var>Capacities</var>, if there is a legal 'transition' from <var> Node</var>'s state to <var>Successor</var>'s state, and <var>Successor</var>'s state is not a member of the <var>Visited</var> states. <syntaxhighlight lang="prolog"> successor( Node, Capacities, Visited, Successor ) :- node_state( Node, State ), Successor = node(Action,State1,Node), jug_transition( State, Capacities, Action, State1 ), \+ member( State1, Visited ). </syntaxhighlight> ===Transition Rules=== ====jug_transition( +State, +Capacities, ?Action, ?SuccessorState )==== holds when <var>Action</var> describes a valid transition, from <var>State</var> to <var>SuccessorState</var>, for water-jugs with <var>Capacities</var>. There are two sorts of <var>Action</var>: * <code>empty_into(Source,Target)</code> valid if <var>Source</var> is not already empty and the combined contents from <var>Source</var> and <var> Target</var>, (in <var>State</var>), are not greater than the capacity of the <var> Target</var> jug. In <var>SuccessorState</var>: <var>Source</var> becomes empty, while the <var>Target</var> jug acquires the combined contents of <var>Source</var> and <var>Target</var> in <var>State</var>. * <code>fill_from(Source,Target)</code> valid if <var>Source</var> is not already empty and the combined contents from <var>Source</var> and <var> Target</var>, (in <var>State</var>), are greater than the capacity of the <var> Target</var> jug. In <var> SuccessorState</var>: the <var>Target</var> jug becomes full, while <var>Source</var> retains the difference between the combined contents of <var>Source</var> and <var>Target</var>, in <var>State</var>, and the capacity of the <var>Target</var> jug. In either case, the contents of the unused jug are unchanged. <syntaxhighlight lang="prolog">jug_transition( State0, Capacities, empty_into(Source,Target), State1 ) :- volume( Source, State0, Content0 ), Content0 > 0, jug_permutation( Source, Target, Unused ), volume( Target, State0, Content1 ), volume( Target, Capacities, Capacity ), Content0 + Content1 =< Capacity, volume( Source, State1, 0 ), volume( Target, State1, Content2 ), Content2 is Content0 + Content1, volume( Unused, State0, Unchanged ), volume( Unused, State1, Unchanged ). jug_transition( State0, Capacities, fill_from(Source,Target), State1 ) :- volume( Source, State0, Content0 ), Content0 > 0, jug_permutation( Source, Target, Unused ), volume( Target, State0, Content1 ), volume( Target, Capacities, Capacity ), Content1 < Capacity, Content0 + Content1 > Capacity, volume( Source, State1, Content2 ), volume( Target, State1, Capacity ), Content2 is Content0 + Content1 - Capacity, volume( Unused, State0, Unchanged ), volume( Unused, State1, Unchanged ).</syntaxhighlight> ==Data Abstraction== ====volume( ?Jug, ?State, ?Volume )==== holds when <var>Jug</var> ('large', 'small' or 'reservoir') has <var>Volume</var> in <var>State</var>. <syntaxhighlight lang="prolog"> volume( small, jugs(Small, _Large, _Reservoir), Small ). volume( large, jugs(_Small, Large, _Reservoir), Large ). volume( reservoir, jugs(_Small, _Large, Reservoir), Reservoir ). </syntaxhighlight> ====jug_permutation( ?Source, ?Target, ?Unused )==== holds when <var>Source</var>, <var>Target</var> and <var>Unused</var> are a permutation of 'small', 'large' and 'reservoir'. <syntaxhighlight lang="prolog"> jug_permutation( Source, Target, Unused ) :- select( Source, [small, large, reservoir], Residue ), select( Target, Residue, [Unused] ). </syntaxhighlight> ====node_state( ?Node, ?State )==== holds when the contents of the water-jugs at <var>Node</var> are described by <var>State</var>. <syntaxhighlight lang="prolog"> node_state( start(State), State ). node_state( node(_Transition, State, _Predecessor), State ). </syntaxhighlight> ==Definite Clause Grammar== ====narrative/5==== is a DCG presenting water-jugs solutions in a readable format. The grammar is 'head-recursive', because the 'nodes list', describing the solution, has the last node outermost. <syntaxhighlight lang="prolog"> narrative( start(Start), Capacities, End ) --> "Given three jugs with capacities of:", newline, literal_volumes( Capacities ), "To obtain the result:", newline, literal_volumes( End ), "Starting with:", newline, literal_volumes( Start ), "Do the following:", newline. narrative( node(Transition, Result, Predecessor), Capacities, End ) --> narrative( Predecessor, Capacities, End ), literal_action( Transition, Result ). literal_volumes( Volumes ) --> indent, literal( Volumes ), ";", newline. literal_action( Transition, Result ) --> indent, "- ", literal( Transition ), " giving:", newline, indent, indent, literal( Result ), newline. literal( empty_into(From,To) ) --> "Empty the ", literal( From ), " into the ", literal( To ). literal( fill_from(From,To) ) --> "Fill the ", literal( To ), " from the ", literal( From ). literal( jugs(Small,Large,Reservoir) ) --> literal_number( Small ), " gallons in the small jug, ", literal_number( Large ), " gallons in the large jug and ", literal_number( Reservoir ), " gallons in the reservoir". literal( small ) --> "small jug". literal( large ) --> "large jug". literal( reservoir ) --> "reservoir". literal_number( Number, Plus, Minus ) :- number( Number ), number_chars( Number, Chars ), append( Chars, Minus, Plus ). indent --> " ". newline --> " ". </syntaxhighlight> ==Utility Predicates== Load a small library of [https://binding-time.co.uk/misc.html puzzle utilities]. <syntaxhighlight lang="prolog"> :- ensure_loaded( misc ). </syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/download/water_jugs.txt here]. ==Output== The output of the program is: <div class="result"> <pre> ?- water_jugs. Given three jugs with capacities of: 3 gallons in the small jug, 4 gallons in the large jug and 8 gallons in the reservoir; To obtain the result: 0 gallons in the small jug, 2 gallons in the large jug and 6 gallons in the reservoir; Starting with: 0 gallons in the small jug, 0 gallons in the large jug and 8 gallons in the reservoir; Do the following: - Fill the small jug from the reservoir giving: 3 gallons in the small jug, 0 gallons in the large jug and 5 gallons in the reservoir - Empty the small jug into the large jug giving: 0 gallons in the small jug, 3 gallons in the large jug and 5 gallons in the reservoir - Fill the small jug from the reservoir giving: 3 gallons in the small jug, 3 gallons in the large jug and 2 gallons in the reservoir - Fill the large jug from the small jug giving: 2 gallons in the small jug, 4 gallons in the large jug and 2 gallons in the reservoir - Empty the large jug into the reservoir giving: 2 gallons in the small jug, 0 gallons in the large jug and 6 gallons in the reservoir - Empty the small jug into the large jug giving: 0 gallons in the small jug, 2 gallons in the large jug and 6 gallons in the reservoir yes </pre> </div> 2e2c6d2f3e4d689e8c689f526dc14d7284f2440d 30 29 2013-09-18T15:16:17Z John 2 /* narrative//5 */ wikitext text/x-wiki __NOTOC__ This classic AI problem is described in ''Artificial Intelligence'' as follows: <blockquote> "You are given two jugs, a 4-gallon one and a 3-gallon one. Neither has any measuring markers on it. There is a tap that can be used to fill the jugs with water. How can you get exactly 2 gallons of water into the 4-gallon jug?". <cite>[http://www.amazon.co.uk/exec/obidos/ASIN/0070522634/bindingtimeli-21 E. Rich & K. Knight, Artificial Intelligence, 2nd edition, McGraw-Hill, 1991]</cite> </blockquote> This program implements an "environmentally responsible" solution to the ''water jugs'' problem. Rather than filling and spilling from an infinite water resource, we conserve a finite initial charge with a third jug: (reservoir). This approach is simpler than the traditional method, because there are only two actions; it is more flexible than the traditional method, because it can solve problems that are constrained by a limited supply from the reservoir. To simulate the infinite version, we use a filled reservoir with a capacity greater than the combined capacities of the jugs, so that the reservoir can never be emptied. <blockquote> "Perfection is achieved not when there is nothing more to add, but when there is nothing more to take away." <cite>[http://en.wikiquote.org/wiki/Antoine_de_Saint-Exupery Antoine de Saint-Exup&#233;ry]</cite> </blockquote> ==Solution== ====water_jugs==== is the entry point. The solution is derived by a simple, breadth-first, state-space search; and translated into a readable format by a DCG. <syntaxhighlight lang="prolog">water_jugs :- SmallCapacity = 3, LargeCapacity = 4, Reservoir is SmallCapacity + LargeCapacity + 1, volume( small, Capacities, SmallCapacity ), volume( large, Capacities, LargeCapacity ), volume( reservoir, Capacities, Reservoir ), volume( small, Start, 0 ), volume( large, Start, 0 ), volume( reservoir, Start, Reservoir ), volume( large, End, 2 ), water_jugs_solution( Start, Capacities, End, Solution ), phrase( narrative(Solution, Capacities, End), Chars ), put_chars( Chars ).</syntaxhighlight> ====water_jugs_solution( +Start, +Capacities, +End, ?Solution )==== holds when <var>Solution</var> is the terminal 'node' in a state-space search - beginning with a 'start state' in which the water-jugs have <var>Capacities</var> and contain the <var>Start</var> volumes. The terminal node is reached when the water-jugs contain the <var>End</var> volumes. <syntaxhighlight lang="prolog"> water_jugs_solution( Start, Capacities, End, Solution ) :- solve_jugs( [start(Start)], Capacities, [], End, Solution ). </syntaxhighlight> ====solve_jugs( +Nodes, +Capacities, +Visited, +End, ?Solution )==== holds when <var>Solution</var> is the terminal 'node' in a state-space search, beginning with a first 'open' node in <var>Nodes</var>, and terminating when the water-jugs contain the <var>End</var> volumes. <var>Capacities</var> define the capacities of the water-jugs, while <var>Visited</var> is a list of expanded ('closed') node states. The 'breadth-first' operation of solve_jugs is due to the 'existing' <var> Nodes</var> being appended to the 'new' nodes. (If the 'new' nodes were appended to the 'existing' nodes, the operation would be 'depth-first'.) <syntaxhighlight lang="prolog"> solve_jugs( [Node|Nodes], Capacities, Visited, End, Solution ) :- node_state( Node, State ), ( State = End -> Solution = Node ; otherwise -> findall( Successor, successor(Node, Capacities, Visited, Successor), Successors ), append( Nodes, Successors, NewNodes ), solve_jugs( NewNodes, Capacities, [State|Visited], End, Solution ) ). </syntaxhighlight> ====successor( +Node, +Capacities, +Visited, ?Successor )==== <var>Successor</var> is a successor of <var>Node</var>, for water-jugs with <var>Capacities</var>, if there is a legal 'transition' from <var> Node</var>'s state to <var>Successor</var>'s state, and <var>Successor</var>'s state is not a member of the <var>Visited</var> states. <syntaxhighlight lang="prolog"> successor( Node, Capacities, Visited, Successor ) :- node_state( Node, State ), Successor = node(Action,State1,Node), jug_transition( State, Capacities, Action, State1 ), \+ member( State1, Visited ). </syntaxhighlight> ===Transition Rules=== ====jug_transition( +State, +Capacities, ?Action, ?SuccessorState )==== holds when <var>Action</var> describes a valid transition, from <var>State</var> to <var>SuccessorState</var>, for water-jugs with <var>Capacities</var>. There are two sorts of <var>Action</var>: * <code>empty_into(Source,Target)</code> valid if <var>Source</var> is not already empty and the combined contents from <var>Source</var> and <var> Target</var>, (in <var>State</var>), are not greater than the capacity of the <var> Target</var> jug. In <var>SuccessorState</var>: <var>Source</var> becomes empty, while the <var>Target</var> jug acquires the combined contents of <var>Source</var> and <var>Target</var> in <var>State</var>. * <code>fill_from(Source,Target)</code> valid if <var>Source</var> is not already empty and the combined contents from <var>Source</var> and <var> Target</var>, (in <var>State</var>), are greater than the capacity of the <var> Target</var> jug. In <var> SuccessorState</var>: the <var>Target</var> jug becomes full, while <var>Source</var> retains the difference between the combined contents of <var>Source</var> and <var>Target</var>, in <var>State</var>, and the capacity of the <var>Target</var> jug. In either case, the contents of the unused jug are unchanged. <syntaxhighlight lang="prolog">jug_transition( State0, Capacities, empty_into(Source,Target), State1 ) :- volume( Source, State0, Content0 ), Content0 > 0, jug_permutation( Source, Target, Unused ), volume( Target, State0, Content1 ), volume( Target, Capacities, Capacity ), Content0 + Content1 =< Capacity, volume( Source, State1, 0 ), volume( Target, State1, Content2 ), Content2 is Content0 + Content1, volume( Unused, State0, Unchanged ), volume( Unused, State1, Unchanged ). jug_transition( State0, Capacities, fill_from(Source,Target), State1 ) :- volume( Source, State0, Content0 ), Content0 > 0, jug_permutation( Source, Target, Unused ), volume( Target, State0, Content1 ), volume( Target, Capacities, Capacity ), Content1 < Capacity, Content0 + Content1 > Capacity, volume( Source, State1, Content2 ), volume( Target, State1, Capacity ), Content2 is Content0 + Content1 - Capacity, volume( Unused, State0, Unchanged ), volume( Unused, State1, Unchanged ).</syntaxhighlight> ==Data Abstraction== ====volume( ?Jug, ?State, ?Volume )==== holds when <var>Jug</var> ('large', 'small' or 'reservoir') has <var>Volume</var> in <var>State</var>. <syntaxhighlight lang="prolog"> volume( small, jugs(Small, _Large, _Reservoir), Small ). volume( large, jugs(_Small, Large, _Reservoir), Large ). volume( reservoir, jugs(_Small, _Large, Reservoir), Reservoir ). </syntaxhighlight> ====jug_permutation( ?Source, ?Target, ?Unused )==== holds when <var>Source</var>, <var>Target</var> and <var>Unused</var> are a permutation of 'small', 'large' and 'reservoir'. <syntaxhighlight lang="prolog"> jug_permutation( Source, Target, Unused ) :- select( Source, [small, large, reservoir], Residue ), select( Target, Residue, [Unused] ). </syntaxhighlight> ====node_state( ?Node, ?State )==== holds when the contents of the water-jugs at <var>Node</var> are described by <var>State</var>. <syntaxhighlight lang="prolog"> node_state( start(State), State ). node_state( node(_Transition, State, _Predecessor), State ). </syntaxhighlight> ==Definite Clause Grammar== ====narrative//5==== is a DCG presenting water-jugs solutions in a readable format. The grammar is 'head-recursive', because the 'nodes list', describing the solution, has the last node outermost. <syntaxhighlight lang="prolog"> narrative( start(Start), Capacities, End ) --> "Given three jugs with capacities of:", newline, literal_volumes( Capacities ), "To obtain the result:", newline, literal_volumes( End ), "Starting with:", newline, literal_volumes( Start ), "Do the following:", newline. narrative( node(Transition, Result, Predecessor), Capacities, End ) --> narrative( Predecessor, Capacities, End ), literal_action( Transition, Result ). literal_volumes( Volumes ) --> indent, literal( Volumes ), ";", newline. literal_action( Transition, Result ) --> indent, "- ", literal( Transition ), " giving:", newline, indent, indent, literal( Result ), newline. literal( empty_into(From,To) ) --> "Empty the ", literal( From ), " into the ", literal( To ). literal( fill_from(From,To) ) --> "Fill the ", literal( To ), " from the ", literal( From ). literal( jugs(Small,Large,Reservoir) ) --> literal_number( Small ), " gallons in the small jug, ", literal_number( Large ), " gallons in the large jug and ", literal_number( Reservoir ), " gallons in the reservoir". literal( small ) --> "small jug". literal( large ) --> "large jug". literal( reservoir ) --> "reservoir". literal_number( Number, Plus, Minus ) :- number( Number ), number_chars( Number, Chars ), append( Chars, Minus, Plus ). indent --> " ". newline --> " ". </syntaxhighlight> ==Utility Predicates== Load a small library of [https://binding-time.co.uk/misc.html puzzle utilities]. <syntaxhighlight lang="prolog"> :- ensure_loaded( misc ). </syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/download/water_jugs.txt here]. ==Output== The output of the program is: <div class="result"> <pre> ?- water_jugs. Given three jugs with capacities of: 3 gallons in the small jug, 4 gallons in the large jug and 8 gallons in the reservoir; To obtain the result: 0 gallons in the small jug, 2 gallons in the large jug and 6 gallons in the reservoir; Starting with: 0 gallons in the small jug, 0 gallons in the large jug and 8 gallons in the reservoir; Do the following: - Fill the small jug from the reservoir giving: 3 gallons in the small jug, 0 gallons in the large jug and 5 gallons in the reservoir - Empty the small jug into the large jug giving: 0 gallons in the small jug, 3 gallons in the large jug and 5 gallons in the reservoir - Fill the small jug from the reservoir giving: 3 gallons in the small jug, 3 gallons in the large jug and 2 gallons in the reservoir - Fill the large jug from the small jug giving: 2 gallons in the small jug, 4 gallons in the large jug and 2 gallons in the reservoir - Empty the large jug into the reservoir giving: 2 gallons in the small jug, 0 gallons in the large jug and 6 gallons in the reservoir - Empty the small jug into the large jug giving: 0 gallons in the small jug, 2 gallons in the large jug and 6 gallons in the reservoir yes </pre> </div> 127de2f53ab07649fd8d5a49ed6c56303345cba3 31 30 2013-09-19T10:39:39Z John 2 /* narrative//5 to SWI? DCG signature notation */ wikitext text/x-wiki __NOTOC__ This classic AI problem is described in ''Artificial Intelligence'' as follows: <blockquote> "You are given two jugs, a 4-gallon one and a 3-gallon one. Neither has any measuring markers on it. There is a tap that can be used to fill the jugs with water. How can you get exactly 2 gallons of water into the 4-gallon jug?". <cite>[http://www.amazon.co.uk/exec/obidos/ASIN/0070522634/bindingtimeli-21 E. Rich & K. Knight, Artificial Intelligence, 2nd edition, McGraw-Hill, 1991]</cite> </blockquote> This program implements an "environmentally responsible" solution to the ''water jugs'' problem. Rather than filling and spilling from an infinite water resource, we conserve a finite initial charge with a third jug: (reservoir). This approach is simpler than the traditional method, because there are only two actions; it is more flexible than the traditional method, because it can solve problems that are constrained by a limited supply from the reservoir. To simulate the infinite version, we use a filled reservoir with a capacity greater than the combined capacities of the jugs, so that the reservoir can never be emptied. <blockquote> "Perfection is achieved not when there is nothing more to add, but when there is nothing more to take away." <cite>[http://en.wikiquote.org/wiki/Antoine_de_Saint-Exupery Antoine de Saint-Exup&#233;ry]</cite> </blockquote> ==Solution== ====water_jugs==== is the entry point. The solution is derived by a simple, breadth-first, state-space search; and translated into a readable format by a DCG. <syntaxhighlight lang="prolog">water_jugs :- SmallCapacity = 3, LargeCapacity = 4, Reservoir is SmallCapacity + LargeCapacity + 1, volume( small, Capacities, SmallCapacity ), volume( large, Capacities, LargeCapacity ), volume( reservoir, Capacities, Reservoir ), volume( small, Start, 0 ), volume( large, Start, 0 ), volume( reservoir, Start, Reservoir ), volume( large, End, 2 ), water_jugs_solution( Start, Capacities, End, Solution ), phrase( narrative(Solution, Capacities, End), Chars ), put_chars( Chars ).</syntaxhighlight> ====water_jugs_solution( +Start, +Capacities, +End, ?Solution )==== holds when <var>Solution</var> is the terminal 'node' in a state-space search - beginning with a 'start state' in which the water-jugs have <var>Capacities</var> and contain the <var>Start</var> volumes. The terminal node is reached when the water-jugs contain the <var>End</var> volumes. <syntaxhighlight lang="prolog"> water_jugs_solution( Start, Capacities, End, Solution ) :- solve_jugs( [start(Start)], Capacities, [], End, Solution ). </syntaxhighlight> ====solve_jugs( +Nodes, +Capacities, +Visited, +End, ?Solution )==== holds when <var>Solution</var> is the terminal 'node' in a state-space search, beginning with a first 'open' node in <var>Nodes</var>, and terminating when the water-jugs contain the <var>End</var> volumes. <var>Capacities</var> define the capacities of the water-jugs, while <var>Visited</var> is a list of expanded ('closed') node states. The 'breadth-first' operation of solve_jugs is due to the 'existing' <var> Nodes</var> being appended to the 'new' nodes. (If the 'new' nodes were appended to the 'existing' nodes, the operation would be 'depth-first'.) <syntaxhighlight lang="prolog"> solve_jugs( [Node|Nodes], Capacities, Visited, End, Solution ) :- node_state( Node, State ), ( State = End -> Solution = Node ; otherwise -> findall( Successor, successor(Node, Capacities, Visited, Successor), Successors ), append( Nodes, Successors, NewNodes ), solve_jugs( NewNodes, Capacities, [State|Visited], End, Solution ) ). </syntaxhighlight> ====successor( +Node, +Capacities, +Visited, ?Successor )==== <var>Successor</var> is a successor of <var>Node</var>, for water-jugs with <var>Capacities</var>, if there is a legal 'transition' from <var> Node</var>'s state to <var>Successor</var>'s state, and <var>Successor</var>'s state is not a member of the <var>Visited</var> states. <syntaxhighlight lang="prolog"> successor( Node, Capacities, Visited, Successor ) :- node_state( Node, State ), Successor = node(Action,State1,Node), jug_transition( State, Capacities, Action, State1 ), \+ member( State1, Visited ). </syntaxhighlight> ===Transition Rules=== ====jug_transition( +State, +Capacities, ?Action, ?SuccessorState )==== holds when <var>Action</var> describes a valid transition, from <var>State</var> to <var>SuccessorState</var>, for water-jugs with <var>Capacities</var>. There are two sorts of <var>Action</var>: * <code>empty_into(Source,Target)</code> valid if <var>Source</var> is not already empty and the combined contents from <var>Source</var> and <var> Target</var>, (in <var>State</var>), are not greater than the capacity of the <var> Target</var> jug. In <var>SuccessorState</var>: <var>Source</var> becomes empty, while the <var>Target</var> jug acquires the combined contents of <var>Source</var> and <var>Target</var> in <var>State</var>. * <code>fill_from(Source,Target)</code> valid if <var>Source</var> is not already empty and the combined contents from <var>Source</var> and <var> Target</var>, (in <var>State</var>), are greater than the capacity of the <var> Target</var> jug. In <var> SuccessorState</var>: the <var>Target</var> jug becomes full, while <var>Source</var> retains the difference between the combined contents of <var>Source</var> and <var>Target</var>, in <var>State</var>, and the capacity of the <var>Target</var> jug. In either case, the contents of the unused jug are unchanged. <syntaxhighlight lang="prolog">jug_transition( State0, Capacities, empty_into(Source,Target), State1 ) :- volume( Source, State0, Content0 ), Content0 > 0, jug_permutation( Source, Target, Unused ), volume( Target, State0, Content1 ), volume( Target, Capacities, Capacity ), Content0 + Content1 =< Capacity, volume( Source, State1, 0 ), volume( Target, State1, Content2 ), Content2 is Content0 + Content1, volume( Unused, State0, Unchanged ), volume( Unused, State1, Unchanged ). jug_transition( State0, Capacities, fill_from(Source,Target), State1 ) :- volume( Source, State0, Content0 ), Content0 > 0, jug_permutation( Source, Target, Unused ), volume( Target, State0, Content1 ), volume( Target, Capacities, Capacity ), Content1 < Capacity, Content0 + Content1 > Capacity, volume( Source, State1, Content2 ), volume( Target, State1, Capacity ), Content2 is Content0 + Content1 - Capacity, volume( Unused, State0, Unchanged ), volume( Unused, State1, Unchanged ).</syntaxhighlight> ==Data Abstraction== ====volume( ?Jug, ?State, ?Volume )==== holds when <var>Jug</var> ('large', 'small' or 'reservoir') has <var>Volume</var> in <var>State</var>. <syntaxhighlight lang="prolog"> volume( small, jugs(Small, _Large, _Reservoir), Small ). volume( large, jugs(_Small, Large, _Reservoir), Large ). volume( reservoir, jugs(_Small, _Large, Reservoir), Reservoir ). </syntaxhighlight> ====jug_permutation( ?Source, ?Target, ?Unused )==== holds when <var>Source</var>, <var>Target</var> and <var>Unused</var> are a permutation of 'small', 'large' and 'reservoir'. <syntaxhighlight lang="prolog"> jug_permutation( Source, Target, Unused ) :- select( Source, [small, large, reservoir], Residue ), select( Target, Residue, [Unused] ). </syntaxhighlight> ====node_state( ?Node, ?State )==== holds when the contents of the water-jugs at <var>Node</var> are described by <var>State</var>. <syntaxhighlight lang="prolog"> node_state( start(State), State ). node_state( node(_Transition, State, _Predecessor), State ). </syntaxhighlight> ==Definite Clause Grammar== ====narrative(+Node, +Capacities, +End )//==== is a DCG presenting water-jugs solutions in a readable format. The grammar is head-recursive, because the 'nodes list' describing the solution has the last node outermost. <syntaxhighlight lang="prolog"> narrative( start(Start), Capacities, End ) --> "Given three jugs with capacities of:", newline, literal_volumes( Capacities ), "To obtain the result:", newline, literal_volumes( End ), "Starting with:", newline, literal_volumes( Start ), "Do the following:", newline. narrative( node(Transition, Result, Predecessor), Capacities, End ) --> narrative( Predecessor, Capacities, End ), literal_action( Transition, Result ). literal_volumes( Volumes ) --> indent, literal( Volumes ), ";", newline. literal_action( Transition, Result ) --> indent, "- ", literal( Transition ), " giving:", newline, indent, indent, literal( Result ), newline. literal( empty_into(From,To) ) --> "Empty the ", literal( From ), " into the ", literal( To ). literal( fill_from(From,To) ) --> "Fill the ", literal( To ), " from the ", literal( From ). literal( jugs(Small,Large,Reservoir) ) --> literal_number( Small ), " gallons in the small jug, ", literal_number( Large ), " gallons in the large jug and ", literal_number( Reservoir ), " gallons in the reservoir". literal( small ) --> "small jug". literal( large ) --> "large jug". literal( reservoir ) --> "reservoir". literal_number( Number, Plus, Minus ) :- number( Number ), number_chars( Number, Chars ), append( Chars, Minus, Plus ). indent --> " ". newline --> " ". </syntaxhighlight> ==Utility Predicates== Load a small library of [https://binding-time.co.uk/misc.html puzzle utilities]. <syntaxhighlight lang="prolog"> :- ensure_loaded( misc ). </syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/download/water_jugs.txt here]. ==Output== The output of the program is: <div class="result"> <pre> ?- water_jugs. Given three jugs with capacities of: 3 gallons in the small jug, 4 gallons in the large jug and 8 gallons in the reservoir; To obtain the result: 0 gallons in the small jug, 2 gallons in the large jug and 6 gallons in the reservoir; Starting with: 0 gallons in the small jug, 0 gallons in the large jug and 8 gallons in the reservoir; Do the following: - Fill the small jug from the reservoir giving: 3 gallons in the small jug, 0 gallons in the large jug and 5 gallons in the reservoir - Empty the small jug into the large jug giving: 0 gallons in the small jug, 3 gallons in the large jug and 5 gallons in the reservoir - Fill the small jug from the reservoir giving: 3 gallons in the small jug, 3 gallons in the large jug and 2 gallons in the reservoir - Fill the large jug from the small jug giving: 2 gallons in the small jug, 4 gallons in the large jug and 2 gallons in the reservoir - Empty the large jug into the reservoir giving: 2 gallons in the small jug, 0 gallons in the large jug and 6 gallons in the reservoir - Empty the small jug into the large jug giving: 0 gallons in the small jug, 2 gallons in the large jug and 6 gallons in the reservoir yes </pre> </div> 4c571cfa573e834eba7f7f247c28d4af4ad5acf7 42 31 2013-10-15T22:51:34Z John 2 /* jug_transition( +State, +Capacities, ?Action, ?SuccessorState ) */ wikitext text/x-wiki __NOTOC__ This classic AI problem is described in ''Artificial Intelligence'' as follows: <blockquote> "You are given two jugs, a 4-gallon one and a 3-gallon one. Neither has any measuring markers on it. There is a tap that can be used to fill the jugs with water. How can you get exactly 2 gallons of water into the 4-gallon jug?". <cite>[http://www.amazon.co.uk/exec/obidos/ASIN/0070522634/bindingtimeli-21 E. Rich & K. Knight, Artificial Intelligence, 2nd edition, McGraw-Hill, 1991]</cite> </blockquote> This program implements an "environmentally responsible" solution to the ''water jugs'' problem. Rather than filling and spilling from an infinite water resource, we conserve a finite initial charge with a third jug: (reservoir). This approach is simpler than the traditional method, because there are only two actions; it is more flexible than the traditional method, because it can solve problems that are constrained by a limited supply from the reservoir. To simulate the infinite version, we use a filled reservoir with a capacity greater than the combined capacities of the jugs, so that the reservoir can never be emptied. <blockquote> "Perfection is achieved not when there is nothing more to add, but when there is nothing more to take away." <cite>[http://en.wikiquote.org/wiki/Antoine_de_Saint-Exupery Antoine de Saint-Exup&#233;ry]</cite> </blockquote> ==Solution== ====water_jugs==== is the entry point. The solution is derived by a simple, breadth-first, state-space search; and translated into a readable format by a DCG. <syntaxhighlight lang="prolog">water_jugs :- SmallCapacity = 3, LargeCapacity = 4, Reservoir is SmallCapacity + LargeCapacity + 1, volume( small, Capacities, SmallCapacity ), volume( large, Capacities, LargeCapacity ), volume( reservoir, Capacities, Reservoir ), volume( small, Start, 0 ), volume( large, Start, 0 ), volume( reservoir, Start, Reservoir ), volume( large, End, 2 ), water_jugs_solution( Start, Capacities, End, Solution ), phrase( narrative(Solution, Capacities, End), Chars ), put_chars( Chars ).</syntaxhighlight> ====water_jugs_solution( +Start, +Capacities, +End, ?Solution )==== holds when <var>Solution</var> is the terminal 'node' in a state-space search - beginning with a 'start state' in which the water-jugs have <var>Capacities</var> and contain the <var>Start</var> volumes. The terminal node is reached when the water-jugs contain the <var>End</var> volumes. <syntaxhighlight lang="prolog"> water_jugs_solution( Start, Capacities, End, Solution ) :- solve_jugs( [start(Start)], Capacities, [], End, Solution ). </syntaxhighlight> ====solve_jugs( +Nodes, +Capacities, +Visited, +End, ?Solution )==== holds when <var>Solution</var> is the terminal 'node' in a state-space search, beginning with a first 'open' node in <var>Nodes</var>, and terminating when the water-jugs contain the <var>End</var> volumes. <var>Capacities</var> define the capacities of the water-jugs, while <var>Visited</var> is a list of expanded ('closed') node states. The 'breadth-first' operation of solve_jugs is due to the 'existing' <var> Nodes</var> being appended to the 'new' nodes. (If the 'new' nodes were appended to the 'existing' nodes, the operation would be 'depth-first'.) <syntaxhighlight lang="prolog"> solve_jugs( [Node|Nodes], Capacities, Visited, End, Solution ) :- node_state( Node, State ), ( State = End -> Solution = Node ; otherwise -> findall( Successor, successor(Node, Capacities, Visited, Successor), Successors ), append( Nodes, Successors, NewNodes ), solve_jugs( NewNodes, Capacities, [State|Visited], End, Solution ) ). </syntaxhighlight> ====successor( +Node, +Capacities, +Visited, ?Successor )==== <var>Successor</var> is a successor of <var>Node</var>, for water-jugs with <var>Capacities</var>, if there is a legal 'transition' from <var> Node</var>'s state to <var>Successor</var>'s state, and <var>Successor</var>'s state is not a member of the <var>Visited</var> states. <syntaxhighlight lang="prolog"> successor( Node, Capacities, Visited, Successor ) :- node_state( Node, State ), Successor = node(Action,State1,Node), jug_transition( State, Capacities, Action, State1 ), \+ member( State1, Visited ). </syntaxhighlight> ===Transition Rules=== ====jug_transition( +State, +Capacities, ?Action, ?SuccessorState )==== holds when <var>Action</var> describes a valid transition, from <var>State</var> to <var>SuccessorState</var>, for water-jugs with <var>Capacities</var>. There are two sorts of <var>Action</var>: * <code>empty_into(Source,Target)</code> valid if ''Source'' is not already empty and the combined contents from ''Source'' and ''Target'', (in <var>State</var>), are not greater than the capacity of the ''Target'' jug. In <var>SuccessorState</var>: ''Source'' becomes empty, while the ''Target'' jug acquires the combined contents of ''Source'' and ''Target'' in <var>State</var>. * <code>fill_from(Source,Target)</code> valid if ''Source'' is not already empty and the combined contents from ''Source'' and ''Target'', (in <var>State</var>), are greater than the capacity of the ''Target'' jug. In <var>SuccessorState</var>: the ''Target'' jug becomes full, while ''Source'' retains the difference between the combined contents of ''Source'' and ''Target'', in <var>State</var>, and the capacity of the ''Target'' jug. In either case, the contents of the unused jug are unchanged. <syntaxhighlight lang="prolog">jug_transition( State0, Capacities, empty_into(Source,Target), State1 ) :- volume( Source, State0, Content0 ), Content0 > 0, jug_permutation( Source, Target, Unused ), volume( Target, State0, Content1 ), volume( Target, Capacities, Capacity ), Content0 + Content1 =< Capacity, volume( Source, State1, 0 ), volume( Target, State1, Content2 ), Content2 is Content0 + Content1, volume( Unused, State0, Unchanged ), volume( Unused, State1, Unchanged ). jug_transition( State0, Capacities, fill_from(Source,Target), State1 ) :- volume( Source, State0, Content0 ), Content0 > 0, jug_permutation( Source, Target, Unused ), volume( Target, State0, Content1 ), volume( Target, Capacities, Capacity ), Content1 < Capacity, Content0 + Content1 > Capacity, volume( Source, State1, Content2 ), volume( Target, State1, Capacity ), Content2 is Content0 + Content1 - Capacity, volume( Unused, State0, Unchanged ), volume( Unused, State1, Unchanged ).</syntaxhighlight> ==Data Abstraction== ====volume( ?Jug, ?State, ?Volume )==== holds when <var>Jug</var> ('large', 'small' or 'reservoir') has <var>Volume</var> in <var>State</var>. <syntaxhighlight lang="prolog"> volume( small, jugs(Small, _Large, _Reservoir), Small ). volume( large, jugs(_Small, Large, _Reservoir), Large ). volume( reservoir, jugs(_Small, _Large, Reservoir), Reservoir ). </syntaxhighlight> ====jug_permutation( ?Source, ?Target, ?Unused )==== holds when <var>Source</var>, <var>Target</var> and <var>Unused</var> are a permutation of 'small', 'large' and 'reservoir'. <syntaxhighlight lang="prolog"> jug_permutation( Source, Target, Unused ) :- select( Source, [small, large, reservoir], Residue ), select( Target, Residue, [Unused] ). </syntaxhighlight> ====node_state( ?Node, ?State )==== holds when the contents of the water-jugs at <var>Node</var> are described by <var>State</var>. <syntaxhighlight lang="prolog"> node_state( start(State), State ). node_state( node(_Transition, State, _Predecessor), State ). </syntaxhighlight> ==Definite Clause Grammar== ====narrative(+Node, +Capacities, +End )//==== is a DCG presenting water-jugs solutions in a readable format. The grammar is head-recursive, because the 'nodes list' describing the solution has the last node outermost. <syntaxhighlight lang="prolog"> narrative( start(Start), Capacities, End ) --> "Given three jugs with capacities of:", newline, literal_volumes( Capacities ), "To obtain the result:", newline, literal_volumes( End ), "Starting with:", newline, literal_volumes( Start ), "Do the following:", newline. narrative( node(Transition, Result, Predecessor), Capacities, End ) --> narrative( Predecessor, Capacities, End ), literal_action( Transition, Result ). literal_volumes( Volumes ) --> indent, literal( Volumes ), ";", newline. literal_action( Transition, Result ) --> indent, "- ", literal( Transition ), " giving:", newline, indent, indent, literal( Result ), newline. literal( empty_into(From,To) ) --> "Empty the ", literal( From ), " into the ", literal( To ). literal( fill_from(From,To) ) --> "Fill the ", literal( To ), " from the ", literal( From ). literal( jugs(Small,Large,Reservoir) ) --> literal_number( Small ), " gallons in the small jug, ", literal_number( Large ), " gallons in the large jug and ", literal_number( Reservoir ), " gallons in the reservoir". literal( small ) --> "small jug". literal( large ) --> "large jug". literal( reservoir ) --> "reservoir". literal_number( Number, Plus, Minus ) :- number( Number ), number_chars( Number, Chars ), append( Chars, Minus, Plus ). indent --> " ". newline --> " ". </syntaxhighlight> ==Utility Predicates== Load a small library of [https://binding-time.co.uk/misc.html puzzle utilities]. <syntaxhighlight lang="prolog"> :- ensure_loaded( misc ). </syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/download/water_jugs.txt here]. ==Output== The output of the program is: <div class="result"> <pre> ?- water_jugs. Given three jugs with capacities of: 3 gallons in the small jug, 4 gallons in the large jug and 8 gallons in the reservoir; To obtain the result: 0 gallons in the small jug, 2 gallons in the large jug and 6 gallons in the reservoir; Starting with: 0 gallons in the small jug, 0 gallons in the large jug and 8 gallons in the reservoir; Do the following: - Fill the small jug from the reservoir giving: 3 gallons in the small jug, 0 gallons in the large jug and 5 gallons in the reservoir - Empty the small jug into the large jug giving: 0 gallons in the small jug, 3 gallons in the large jug and 5 gallons in the reservoir - Fill the small jug from the reservoir giving: 3 gallons in the small jug, 3 gallons in the large jug and 2 gallons in the reservoir - Fill the large jug from the small jug giving: 2 gallons in the small jug, 4 gallons in the large jug and 2 gallons in the reservoir - Empty the large jug into the reservoir giving: 2 gallons in the small jug, 0 gallons in the large jug and 6 gallons in the reservoir - Empty the small jug into the large jug giving: 0 gallons in the small jug, 2 gallons in the large jug and 6 gallons in the reservoir yes </pre> </div> 869e24ec7108fbdbbeeb419f4b71e8a4348514ed 43 42 2013-10-15T22:57:06Z John 2 wikitext text/x-wiki __NOTOC__ This classic AI problem is described in ''Artificial Intelligence'' as follows: <blockquote> "You are given two jugs, a 4-gallon one and a 3-gallon one. Neither has any measuring markers on it. There is a tap that can be used to fill the jugs with water. How can you get exactly 2 gallons of water into the 4-gallon jug?". <cite>[http://www.amazon.co.uk/exec/obidos/ASIN/0070522634/bindingtimeli-21 E. Rich & K. Knight, Artificial Intelligence, 2nd edition, McGraw-Hill, 1991]</cite> </blockquote> This program implements an "environmentally responsible" solution to the ''water jugs'' problem. Rather than filling and spilling from an infinite water resource, we conserve a finite initial charge with a third jug: (reservoir). This approach is simpler than the traditional method, because there are only two actions; it is more flexible than the traditional method, because it can solve problems that are constrained by a limited supply from the reservoir. To simulate the infinite version, we use a filled reservoir with a capacity greater than the combined capacities of the jugs, so that the reservoir can never be emptied. <blockquote> "Perfection is achieved not when there is nothing more to add, but when there is nothing more to take away." <cite>[http://en.wikiquote.org/wiki/Antoine_de_Saint-Exupery Antoine de Saint-Exup&#233;ry]</cite> </blockquote> ==Solution== ====water_jugs==== is the entry point. The solution is derived by a simple, breadth-first, state-space search; and translated into a readable format by a DCG. <syntaxhighlight lang="prolog">water_jugs :- SmallCapacity = 3, LargeCapacity = 4, Reservoir is SmallCapacity + LargeCapacity + 1, volume( small, Capacities, SmallCapacity ), volume( large, Capacities, LargeCapacity ), volume( reservoir, Capacities, Reservoir ), volume( small, Start, 0 ), volume( large, Start, 0 ), volume( reservoir, Start, Reservoir ), volume( large, End, 2 ), water_jugs_solution( Start, Capacities, End, Solution ), phrase( narrative(Solution, Capacities, End), Chars ), put_chars( Chars ).</syntaxhighlight> ====water_jugs_solution( +Start, +Capacities, +End, ?Solution )==== holds when <var>Solution</var> is the terminal 'node' in a state-space search - beginning with a 'start state' in which the water-jugs have <var>Capacities</var> and contain the <var>Start</var> volumes. The terminal node is reached when the water-jugs contain the <var>End</var> volumes. <syntaxhighlight lang="prolog"> water_jugs_solution( Start, Capacities, End, Solution ) :- solve_jugs( [start(Start)], Capacities, [], End, Solution ). </syntaxhighlight> ====solve_jugs( +Nodes, +Capacities, +Visited, +End, ?Solution )==== holds when <var>Solution</var> is the terminal 'node' in a state-space search, beginning with a first 'open' node in <var>Nodes</var>, and terminating when the water-jugs contain the <var>End</var> volumes. <var>Capacities</var> define the capacities of the water-jugs, while <var>Visited</var> is a list of expanded ('closed') node states. The 'breadth-first' operation of solve_jugs is due to the 'existing' <var> Nodes</var> being appended to the 'new' nodes. (If the 'new' nodes were appended to the 'existing' nodes, the operation would be 'depth-first'.) <syntaxhighlight lang="prolog"> solve_jugs( [Node|Nodes], Capacities, Visited, End, Solution ) :- node_state( Node, State ), ( State = End -> Solution = Node ; otherwise -> findall( Successor, successor(Node, Capacities, Visited, Successor), Successors ), append( Nodes, Successors, NewNodes ), solve_jugs( NewNodes, Capacities, [State|Visited], End, Solution ) ). </syntaxhighlight> ====successor( +Node, +Capacities, +Visited, ?Successor )==== <var>Successor</var> is a successor of <var>Node</var>, for water-jugs with <var>Capacities</var>, if there is a legal 'transition' from <var>Node</var>'s state to <var>Successor</var>'s state, and <var>Successor</var>'s state is not a member of the <var>Visited</var> states. <syntaxhighlight lang="prolog"> successor( Node, Capacities, Visited, Successor ) :- node_state( Node, State ), Successor = node(Action,State1,Node), jug_transition( State, Capacities, Action, State1 ), \+ member( State1, Visited ). </syntaxhighlight> ===Transition Rules=== ====jug_transition( +State, +Capacities, ?Action, ?SuccessorState )==== holds when <var>Action</var> describes a valid transition, from <var>State</var> to <var>SuccessorState</var>, for water-jugs with <var>Capacities</var>. There are two sorts of <var>Action</var>: * <code>empty_into(Source,Target)</code> valid if ''Source'' is not already empty and the combined contents from ''Source'' and ''Target'', (in <var>State</var>), are not greater than the capacity of the ''Target'' jug. In <var>SuccessorState</var>: ''Source'' becomes empty, while the ''Target'' jug acquires the combined contents of ''Source'' and ''Target'' in <var>State</var>. * <code>fill_from(Source,Target)</code> valid if ''Source'' is not already empty and the combined contents from ''Source'' and ''Target'', (in <var>State</var>), are greater than the capacity of the ''Target'' jug. In <var>SuccessorState</var>: the ''Target'' jug becomes full, while ''Source'' retains the difference between the combined contents of ''Source'' and ''Target'', in <var>State</var>, and the capacity of the ''Target'' jug. In either case, the contents of the unused jug are unchanged. <syntaxhighlight lang="prolog">jug_transition( State0, Capacities, empty_into(Source,Target), State1 ) :- volume( Source, State0, Content0 ), Content0 > 0, jug_permutation( Source, Target, Unused ), volume( Target, State0, Content1 ), volume( Target, Capacities, Capacity ), Content0 + Content1 =< Capacity, volume( Source, State1, 0 ), volume( Target, State1, Content2 ), Content2 is Content0 + Content1, volume( Unused, State0, Unchanged ), volume( Unused, State1, Unchanged ). jug_transition( State0, Capacities, fill_from(Source,Target), State1 ) :- volume( Source, State0, Content0 ), Content0 > 0, jug_permutation( Source, Target, Unused ), volume( Target, State0, Content1 ), volume( Target, Capacities, Capacity ), Content1 < Capacity, Content0 + Content1 > Capacity, volume( Source, State1, Content2 ), volume( Target, State1, Capacity ), Content2 is Content0 + Content1 - Capacity, volume( Unused, State0, Unchanged ), volume( Unused, State1, Unchanged ).</syntaxhighlight> ==Data Abstraction== ====volume( ?Jug, ?State, ?Volume )==== holds when <var>Jug</var> ('large', 'small' or 'reservoir') has <var>Volume</var> in <var>State</var>. <syntaxhighlight lang="prolog"> volume( small, jugs(Small, _Large, _Reservoir), Small ). volume( large, jugs(_Small, Large, _Reservoir), Large ). volume( reservoir, jugs(_Small, _Large, Reservoir), Reservoir ). </syntaxhighlight> ====jug_permutation( ?Source, ?Target, ?Unused )==== holds when <var>Source</var>, <var>Target</var> and <var>Unused</var> are a permutation of 'small', 'large' and 'reservoir'. <syntaxhighlight lang="prolog"> jug_permutation( Source, Target, Unused ) :- select( Source, [small, large, reservoir], Residue ), select( Target, Residue, [Unused] ). </syntaxhighlight> ====node_state( ?Node, ?State )==== holds when the contents of the water-jugs at <var>Node</var> are described by <var>State</var>. <syntaxhighlight lang="prolog"> node_state( start(State), State ). node_state( node(_Transition, State, _Predecessor), State ). </syntaxhighlight> ==Definite Clause Grammar== ====narrative//3==== is a DCG presenting water-jugs solutions in a readable format. The grammar is head-recursive, because the 'nodes list' describing the solution has the last node outermost. <syntaxhighlight lang="prolog"> narrative( start(Start), Capacities, End ) --> "Given three jugs with capacities of:", newline, literal_volumes( Capacities ), "To obtain the result:", newline, literal_volumes( End ), "Starting with:", newline, literal_volumes( Start ), "Do the following:", newline. narrative( node(Transition, Result, Predecessor), Capacities, End ) --> narrative( Predecessor, Capacities, End ), literal_action( Transition, Result ). literal_volumes( Volumes ) --> indent, literal( Volumes ), ";", newline. literal_action( Transition, Result ) --> indent, "- ", literal( Transition ), " giving:", newline, indent, indent, literal( Result ), newline. literal( empty_into(From,To) ) --> "Empty the ", literal( From ), " into the ", literal( To ). literal( fill_from(From,To) ) --> "Fill the ", literal( To ), " from the ", literal( From ). literal( jugs(Small,Large,Reservoir) ) --> literal_number( Small ), " gallons in the small jug, ", literal_number( Large ), " gallons in the large jug and ", literal_number( Reservoir ), " gallons in the reservoir". literal( small ) --> "small jug". literal( large ) --> "large jug". literal( reservoir ) --> "reservoir". literal_number( Number, Plus, Minus ) :- number( Number ), number_chars( Number, Chars ), append( Chars, Minus, Plus ). indent --> " ". newline --> " ". </syntaxhighlight> ==Utility Predicates== Load a small library of [https://binding-time.co.uk/misc.html puzzle utilities]. <syntaxhighlight lang="prolog"> :- ensure_loaded( misc ). </syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/download/water_jugs.txt here]. ==Output== The output of the program is: <div class="result"> <pre> ?- water_jugs. Given three jugs with capacities of: 3 gallons in the small jug, 4 gallons in the large jug and 8 gallons in the reservoir; To obtain the result: 0 gallons in the small jug, 2 gallons in the large jug and 6 gallons in the reservoir; Starting with: 0 gallons in the small jug, 0 gallons in the large jug and 8 gallons in the reservoir; Do the following: - Fill the small jug from the reservoir giving: 3 gallons in the small jug, 0 gallons in the large jug and 5 gallons in the reservoir - Empty the small jug into the large jug giving: 0 gallons in the small jug, 3 gallons in the large jug and 5 gallons in the reservoir - Fill the small jug from the reservoir giving: 3 gallons in the small jug, 3 gallons in the large jug and 2 gallons in the reservoir - Fill the large jug from the small jug giving: 2 gallons in the small jug, 4 gallons in the large jug and 2 gallons in the reservoir - Empty the large jug into the reservoir giving: 2 gallons in the small jug, 0 gallons in the large jug and 6 gallons in the reservoir - Empty the small jug into the large jug giving: 0 gallons in the small jug, 2 gallons in the large jug and 6 gallons in the reservoir yes </pre> </div> a554a2d1f0a299cc4de9ecbc8abec6f0bd899869 44 43 2013-10-15T22:58:29Z John 2 /* solve_jugs( +Nodes, +Capacities, +Visited, +End, ?Solution ) */ wikitext text/x-wiki __NOTOC__ This classic AI problem is described in ''Artificial Intelligence'' as follows: <blockquote> "You are given two jugs, a 4-gallon one and a 3-gallon one. Neither has any measuring markers on it. There is a tap that can be used to fill the jugs with water. How can you get exactly 2 gallons of water into the 4-gallon jug?". <cite>[http://www.amazon.co.uk/exec/obidos/ASIN/0070522634/bindingtimeli-21 E. Rich & K. Knight, Artificial Intelligence, 2nd edition, McGraw-Hill, 1991]</cite> </blockquote> This program implements an "environmentally responsible" solution to the ''water jugs'' problem. Rather than filling and spilling from an infinite water resource, we conserve a finite initial charge with a third jug: (reservoir). This approach is simpler than the traditional method, because there are only two actions; it is more flexible than the traditional method, because it can solve problems that are constrained by a limited supply from the reservoir. To simulate the infinite version, we use a filled reservoir with a capacity greater than the combined capacities of the jugs, so that the reservoir can never be emptied. <blockquote> "Perfection is achieved not when there is nothing more to add, but when there is nothing more to take away." <cite>[http://en.wikiquote.org/wiki/Antoine_de_Saint-Exupery Antoine de Saint-Exup&#233;ry]</cite> </blockquote> ==Solution== ====water_jugs==== is the entry point. The solution is derived by a simple, breadth-first, state-space search; and translated into a readable format by a DCG. <syntaxhighlight lang="prolog">water_jugs :- SmallCapacity = 3, LargeCapacity = 4, Reservoir is SmallCapacity + LargeCapacity + 1, volume( small, Capacities, SmallCapacity ), volume( large, Capacities, LargeCapacity ), volume( reservoir, Capacities, Reservoir ), volume( small, Start, 0 ), volume( large, Start, 0 ), volume( reservoir, Start, Reservoir ), volume( large, End, 2 ), water_jugs_solution( Start, Capacities, End, Solution ), phrase( narrative(Solution, Capacities, End), Chars ), put_chars( Chars ).</syntaxhighlight> ====water_jugs_solution( +Start, +Capacities, +End, ?Solution )==== holds when <var>Solution</var> is the terminal 'node' in a state-space search - beginning with a 'start state' in which the water-jugs have <var>Capacities</var> and contain the <var>Start</var> volumes. The terminal node is reached when the water-jugs contain the <var>End</var> volumes. <syntaxhighlight lang="prolog"> water_jugs_solution( Start, Capacities, End, Solution ) :- solve_jugs( [start(Start)], Capacities, [], End, Solution ). </syntaxhighlight> ====solve_jugs( +Nodes, +Capacities, +Visited, +End, ?Solution )==== holds when <var>Solution</var> is the terminal 'node' in a state-space search, beginning with a first 'open' node in <var>Nodes</var>, and terminating when the water-jugs contain the <var>End</var> volumes. <var>Capacities</var> define the capacities of the water-jugs, while <var>Visited</var> is a list of expanded ('closed') node states. The 'breadth-first' operation of solve_jugs is due to the 'existing' <var>Nodes</var> being appended to the 'new' nodes. (If the 'new' nodes were appended to the 'existing' nodes, the operation would be 'depth-first'.) <syntaxhighlight lang="prolog"> solve_jugs( [Node|Nodes], Capacities, Visited, End, Solution ) :- node_state( Node, State ), ( State = End -> Solution = Node ; otherwise -> findall( Successor, successor(Node, Capacities, Visited, Successor), Successors ), append( Nodes, Successors, NewNodes ), solve_jugs( NewNodes, Capacities, [State|Visited], End, Solution ) ). </syntaxhighlight> ====successor( +Node, +Capacities, +Visited, ?Successor )==== <var>Successor</var> is a successor of <var>Node</var>, for water-jugs with <var>Capacities</var>, if there is a legal 'transition' from <var>Node</var>'s state to <var>Successor</var>'s state, and <var>Successor</var>'s state is not a member of the <var>Visited</var> states. <syntaxhighlight lang="prolog"> successor( Node, Capacities, Visited, Successor ) :- node_state( Node, State ), Successor = node(Action,State1,Node), jug_transition( State, Capacities, Action, State1 ), \+ member( State1, Visited ). </syntaxhighlight> ===Transition Rules=== ====jug_transition( +State, +Capacities, ?Action, ?SuccessorState )==== holds when <var>Action</var> describes a valid transition, from <var>State</var> to <var>SuccessorState</var>, for water-jugs with <var>Capacities</var>. There are two sorts of <var>Action</var>: * <code>empty_into(Source,Target)</code> valid if ''Source'' is not already empty and the combined contents from ''Source'' and ''Target'', (in <var>State</var>), are not greater than the capacity of the ''Target'' jug. In <var>SuccessorState</var>: ''Source'' becomes empty, while the ''Target'' jug acquires the combined contents of ''Source'' and ''Target'' in <var>State</var>. * <code>fill_from(Source,Target)</code> valid if ''Source'' is not already empty and the combined contents from ''Source'' and ''Target'', (in <var>State</var>), are greater than the capacity of the ''Target'' jug. In <var>SuccessorState</var>: the ''Target'' jug becomes full, while ''Source'' retains the difference between the combined contents of ''Source'' and ''Target'', in <var>State</var>, and the capacity of the ''Target'' jug. In either case, the contents of the unused jug are unchanged. <syntaxhighlight lang="prolog">jug_transition( State0, Capacities, empty_into(Source,Target), State1 ) :- volume( Source, State0, Content0 ), Content0 > 0, jug_permutation( Source, Target, Unused ), volume( Target, State0, Content1 ), volume( Target, Capacities, Capacity ), Content0 + Content1 =< Capacity, volume( Source, State1, 0 ), volume( Target, State1, Content2 ), Content2 is Content0 + Content1, volume( Unused, State0, Unchanged ), volume( Unused, State1, Unchanged ). jug_transition( State0, Capacities, fill_from(Source,Target), State1 ) :- volume( Source, State0, Content0 ), Content0 > 0, jug_permutation( Source, Target, Unused ), volume( Target, State0, Content1 ), volume( Target, Capacities, Capacity ), Content1 < Capacity, Content0 + Content1 > Capacity, volume( Source, State1, Content2 ), volume( Target, State1, Capacity ), Content2 is Content0 + Content1 - Capacity, volume( Unused, State0, Unchanged ), volume( Unused, State1, Unchanged ).</syntaxhighlight> ==Data Abstraction== ====volume( ?Jug, ?State, ?Volume )==== holds when <var>Jug</var> ('large', 'small' or 'reservoir') has <var>Volume</var> in <var>State</var>. <syntaxhighlight lang="prolog"> volume( small, jugs(Small, _Large, _Reservoir), Small ). volume( large, jugs(_Small, Large, _Reservoir), Large ). volume( reservoir, jugs(_Small, _Large, Reservoir), Reservoir ). </syntaxhighlight> ====jug_permutation( ?Source, ?Target, ?Unused )==== holds when <var>Source</var>, <var>Target</var> and <var>Unused</var> are a permutation of 'small', 'large' and 'reservoir'. <syntaxhighlight lang="prolog"> jug_permutation( Source, Target, Unused ) :- select( Source, [small, large, reservoir], Residue ), select( Target, Residue, [Unused] ). </syntaxhighlight> ====node_state( ?Node, ?State )==== holds when the contents of the water-jugs at <var>Node</var> are described by <var>State</var>. <syntaxhighlight lang="prolog"> node_state( start(State), State ). node_state( node(_Transition, State, _Predecessor), State ). </syntaxhighlight> ==Definite Clause Grammar== ====narrative//3==== is a DCG presenting water-jugs solutions in a readable format. The grammar is head-recursive, because the 'nodes list' describing the solution has the last node outermost. <syntaxhighlight lang="prolog"> narrative( start(Start), Capacities, End ) --> "Given three jugs with capacities of:", newline, literal_volumes( Capacities ), "To obtain the result:", newline, literal_volumes( End ), "Starting with:", newline, literal_volumes( Start ), "Do the following:", newline. narrative( node(Transition, Result, Predecessor), Capacities, End ) --> narrative( Predecessor, Capacities, End ), literal_action( Transition, Result ). literal_volumes( Volumes ) --> indent, literal( Volumes ), ";", newline. literal_action( Transition, Result ) --> indent, "- ", literal( Transition ), " giving:", newline, indent, indent, literal( Result ), newline. literal( empty_into(From,To) ) --> "Empty the ", literal( From ), " into the ", literal( To ). literal( fill_from(From,To) ) --> "Fill the ", literal( To ), " from the ", literal( From ). literal( jugs(Small,Large,Reservoir) ) --> literal_number( Small ), " gallons in the small jug, ", literal_number( Large ), " gallons in the large jug and ", literal_number( Reservoir ), " gallons in the reservoir". literal( small ) --> "small jug". literal( large ) --> "large jug". literal( reservoir ) --> "reservoir". literal_number( Number, Plus, Minus ) :- number( Number ), number_chars( Number, Chars ), append( Chars, Minus, Plus ). indent --> " ". newline --> " ". </syntaxhighlight> ==Utility Predicates== Load a small library of [https://binding-time.co.uk/misc.html puzzle utilities]. <syntaxhighlight lang="prolog"> :- ensure_loaded( misc ). </syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/download/water_jugs.txt here]. ==Output== The output of the program is: <div class="result"> <pre> ?- water_jugs. Given three jugs with capacities of: 3 gallons in the small jug, 4 gallons in the large jug and 8 gallons in the reservoir; To obtain the result: 0 gallons in the small jug, 2 gallons in the large jug and 6 gallons in the reservoir; Starting with: 0 gallons in the small jug, 0 gallons in the large jug and 8 gallons in the reservoir; Do the following: - Fill the small jug from the reservoir giving: 3 gallons in the small jug, 0 gallons in the large jug and 5 gallons in the reservoir - Empty the small jug into the large jug giving: 0 gallons in the small jug, 3 gallons in the large jug and 5 gallons in the reservoir - Fill the small jug from the reservoir giving: 3 gallons in the small jug, 3 gallons in the large jug and 2 gallons in the reservoir - Fill the large jug from the small jug giving: 2 gallons in the small jug, 4 gallons in the large jug and 2 gallons in the reservoir - Empty the large jug into the reservoir giving: 2 gallons in the small jug, 0 gallons in the large jug and 6 gallons in the reservoir - Empty the small jug into the large jug giving: 0 gallons in the small jug, 2 gallons in the large jug and 6 gallons in the reservoir yes </pre> </div> 4eb7d988b11f1b21054f89904619de48584f57f9 46 44 2013-10-19T19:42:22Z John 2 /* Utility Predicates */ wikitext text/x-wiki __NOTOC__ This classic AI problem is described in ''Artificial Intelligence'' as follows: <blockquote> "You are given two jugs, a 4-gallon one and a 3-gallon one. Neither has any measuring markers on it. There is a tap that can be used to fill the jugs with water. How can you get exactly 2 gallons of water into the 4-gallon jug?". <cite>[http://www.amazon.co.uk/exec/obidos/ASIN/0070522634/bindingtimeli-21 E. Rich & K. Knight, Artificial Intelligence, 2nd edition, McGraw-Hill, 1991]</cite> </blockquote> This program implements an "environmentally responsible" solution to the ''water jugs'' problem. Rather than filling and spilling from an infinite water resource, we conserve a finite initial charge with a third jug: (reservoir). This approach is simpler than the traditional method, because there are only two actions; it is more flexible than the traditional method, because it can solve problems that are constrained by a limited supply from the reservoir. To simulate the infinite version, we use a filled reservoir with a capacity greater than the combined capacities of the jugs, so that the reservoir can never be emptied. <blockquote> "Perfection is achieved not when there is nothing more to add, but when there is nothing more to take away." <cite>[http://en.wikiquote.org/wiki/Antoine_de_Saint-Exupery Antoine de Saint-Exup&#233;ry]</cite> </blockquote> ==Solution== ====water_jugs==== is the entry point. The solution is derived by a simple, breadth-first, state-space search; and translated into a readable format by a DCG. <syntaxhighlight lang="prolog">water_jugs :- SmallCapacity = 3, LargeCapacity = 4, Reservoir is SmallCapacity + LargeCapacity + 1, volume( small, Capacities, SmallCapacity ), volume( large, Capacities, LargeCapacity ), volume( reservoir, Capacities, Reservoir ), volume( small, Start, 0 ), volume( large, Start, 0 ), volume( reservoir, Start, Reservoir ), volume( large, End, 2 ), water_jugs_solution( Start, Capacities, End, Solution ), phrase( narrative(Solution, Capacities, End), Chars ), put_chars( Chars ).</syntaxhighlight> ====water_jugs_solution( +Start, +Capacities, +End, ?Solution )==== holds when <var>Solution</var> is the terminal 'node' in a state-space search - beginning with a 'start state' in which the water-jugs have <var>Capacities</var> and contain the <var>Start</var> volumes. The terminal node is reached when the water-jugs contain the <var>End</var> volumes. <syntaxhighlight lang="prolog"> water_jugs_solution( Start, Capacities, End, Solution ) :- solve_jugs( [start(Start)], Capacities, [], End, Solution ). </syntaxhighlight> ====solve_jugs( +Nodes, +Capacities, +Visited, +End, ?Solution )==== holds when <var>Solution</var> is the terminal 'node' in a state-space search, beginning with a first 'open' node in <var>Nodes</var>, and terminating when the water-jugs contain the <var>End</var> volumes. <var>Capacities</var> define the capacities of the water-jugs, while <var>Visited</var> is a list of expanded ('closed') node states. The 'breadth-first' operation of solve_jugs is due to the 'existing' <var>Nodes</var> being appended to the 'new' nodes. (If the 'new' nodes were appended to the 'existing' nodes, the operation would be 'depth-first'.) <syntaxhighlight lang="prolog"> solve_jugs( [Node|Nodes], Capacities, Visited, End, Solution ) :- node_state( Node, State ), ( State = End -> Solution = Node ; otherwise -> findall( Successor, successor(Node, Capacities, Visited, Successor), Successors ), append( Nodes, Successors, NewNodes ), solve_jugs( NewNodes, Capacities, [State|Visited], End, Solution ) ). </syntaxhighlight> ====successor( +Node, +Capacities, +Visited, ?Successor )==== <var>Successor</var> is a successor of <var>Node</var>, for water-jugs with <var>Capacities</var>, if there is a legal 'transition' from <var>Node</var>'s state to <var>Successor</var>'s state, and <var>Successor</var>'s state is not a member of the <var>Visited</var> states. <syntaxhighlight lang="prolog"> successor( Node, Capacities, Visited, Successor ) :- node_state( Node, State ), Successor = node(Action,State1,Node), jug_transition( State, Capacities, Action, State1 ), \+ member( State1, Visited ). </syntaxhighlight> ===Transition Rules=== ====jug_transition( +State, +Capacities, ?Action, ?SuccessorState )==== holds when <var>Action</var> describes a valid transition, from <var>State</var> to <var>SuccessorState</var>, for water-jugs with <var>Capacities</var>. There are two sorts of <var>Action</var>: * <code>empty_into(Source,Target)</code> valid if ''Source'' is not already empty and the combined contents from ''Source'' and ''Target'', (in <var>State</var>), are not greater than the capacity of the ''Target'' jug. In <var>SuccessorState</var>: ''Source'' becomes empty, while the ''Target'' jug acquires the combined contents of ''Source'' and ''Target'' in <var>State</var>. * <code>fill_from(Source,Target)</code> valid if ''Source'' is not already empty and the combined contents from ''Source'' and ''Target'', (in <var>State</var>), are greater than the capacity of the ''Target'' jug. In <var>SuccessorState</var>: the ''Target'' jug becomes full, while ''Source'' retains the difference between the combined contents of ''Source'' and ''Target'', in <var>State</var>, and the capacity of the ''Target'' jug. In either case, the contents of the unused jug are unchanged. <syntaxhighlight lang="prolog">jug_transition( State0, Capacities, empty_into(Source,Target), State1 ) :- volume( Source, State0, Content0 ), Content0 > 0, jug_permutation( Source, Target, Unused ), volume( Target, State0, Content1 ), volume( Target, Capacities, Capacity ), Content0 + Content1 =< Capacity, volume( Source, State1, 0 ), volume( Target, State1, Content2 ), Content2 is Content0 + Content1, volume( Unused, State0, Unchanged ), volume( Unused, State1, Unchanged ). jug_transition( State0, Capacities, fill_from(Source,Target), State1 ) :- volume( Source, State0, Content0 ), Content0 > 0, jug_permutation( Source, Target, Unused ), volume( Target, State0, Content1 ), volume( Target, Capacities, Capacity ), Content1 < Capacity, Content0 + Content1 > Capacity, volume( Source, State1, Content2 ), volume( Target, State1, Capacity ), Content2 is Content0 + Content1 - Capacity, volume( Unused, State0, Unchanged ), volume( Unused, State1, Unchanged ).</syntaxhighlight> ==Data Abstraction== ====volume( ?Jug, ?State, ?Volume )==== holds when <var>Jug</var> ('large', 'small' or 'reservoir') has <var>Volume</var> in <var>State</var>. <syntaxhighlight lang="prolog"> volume( small, jugs(Small, _Large, _Reservoir), Small ). volume( large, jugs(_Small, Large, _Reservoir), Large ). volume( reservoir, jugs(_Small, _Large, Reservoir), Reservoir ). </syntaxhighlight> ====jug_permutation( ?Source, ?Target, ?Unused )==== holds when <var>Source</var>, <var>Target</var> and <var>Unused</var> are a permutation of 'small', 'large' and 'reservoir'. <syntaxhighlight lang="prolog"> jug_permutation( Source, Target, Unused ) :- select( Source, [small, large, reservoir], Residue ), select( Target, Residue, [Unused] ). </syntaxhighlight> ====node_state( ?Node, ?State )==== holds when the contents of the water-jugs at <var>Node</var> are described by <var>State</var>. <syntaxhighlight lang="prolog"> node_state( start(State), State ). node_state( node(_Transition, State, _Predecessor), State ). </syntaxhighlight> ==Definite Clause Grammar== ====narrative//3==== is a DCG presenting water-jugs solutions in a readable format. The grammar is head-recursive, because the 'nodes list' describing the solution has the last node outermost. <syntaxhighlight lang="prolog"> narrative( start(Start), Capacities, End ) --> "Given three jugs with capacities of:", newline, literal_volumes( Capacities ), "To obtain the result:", newline, literal_volumes( End ), "Starting with:", newline, literal_volumes( Start ), "Do the following:", newline. narrative( node(Transition, Result, Predecessor), Capacities, End ) --> narrative( Predecessor, Capacities, End ), literal_action( Transition, Result ). literal_volumes( Volumes ) --> indent, literal( Volumes ), ";", newline. literal_action( Transition, Result ) --> indent, "- ", literal( Transition ), " giving:", newline, indent, indent, literal( Result ), newline. literal( empty_into(From,To) ) --> "Empty the ", literal( From ), " into the ", literal( To ). literal( fill_from(From,To) ) --> "Fill the ", literal( To ), " from the ", literal( From ). literal( jugs(Small,Large,Reservoir) ) --> literal_number( Small ), " gallons in the small jug, ", literal_number( Large ), " gallons in the large jug and ", literal_number( Reservoir ), " gallons in the reservoir". literal( small ) --> "small jug". literal( large ) --> "large jug". literal( reservoir ) --> "reservoir". literal_number( Number, Plus, Minus ) :- number( Number ), number_chars( Number, Chars ), append( Chars, Minus, Plus ). indent --> " ". newline --> " ". </syntaxhighlight> ==Utility Predicates== Load a small library of [[Puzzle Utilities]]. <syntaxhighlight lang="prolog"> :- ensure_loaded( misc ). </syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/download/water_jugs.txt here]. ==Output== The output of the program is: <div class="result"> <pre> ?- water_jugs. Given three jugs with capacities of: 3 gallons in the small jug, 4 gallons in the large jug and 8 gallons in the reservoir; To obtain the result: 0 gallons in the small jug, 2 gallons in the large jug and 6 gallons in the reservoir; Starting with: 0 gallons in the small jug, 0 gallons in the large jug and 8 gallons in the reservoir; Do the following: - Fill the small jug from the reservoir giving: 3 gallons in the small jug, 0 gallons in the large jug and 5 gallons in the reservoir - Empty the small jug into the large jug giving: 0 gallons in the small jug, 3 gallons in the large jug and 5 gallons in the reservoir - Fill the small jug from the reservoir giving: 3 gallons in the small jug, 3 gallons in the large jug and 2 gallons in the reservoir - Fill the large jug from the small jug giving: 2 gallons in the small jug, 4 gallons in the large jug and 2 gallons in the reservoir - Empty the large jug into the reservoir giving: 2 gallons in the small jug, 0 gallons in the large jug and 6 gallons in the reservoir - Empty the small jug into the large jug giving: 0 gallons in the small jug, 2 gallons in the large jug and 6 gallons in the reservoir yes </pre> </div> 526e49b3a8e94d305b1fcbacc2c9c3b511c74c6f 0 9 32 2013-10-09T20:49:43Z WikiSysop 1 Redirected page to [[This Prolog Life]] wikitext text/x-wiki #REDIRECT [[This_Prolog_Life]] feebcf98dfc6a91121aac09f8730bfa9f436de6e 0 10 33 2013-10-13T21:49:22Z John 2 Created page with "==Constrained Permutations in Prolog== __NOTOC__ Problem posted to [http://groups.google.com/group/comp.lang.prolog/msg/a984ea325e0a4180 comp.lang.prolog] by Daniel Dudley =..." wikitext text/x-wiki ==Constrained Permutations in Prolog== __NOTOC__ Problem posted to [http://groups.google.com/group/comp.lang.prolog/msg/a984ea325e0a4180 comp.lang.prolog] by Daniel Dudley ===Problem Statement=== <blockquote>A university was to hold an examination in 5 subjects: Norwegian, German, English, French and Spanish. In each of these languages there were 4 candidates. The examination room was therefore divided into 20 cells, as shown in the figure below (view this in a fixed font): <pre> X X X X X X X X X X X X X X X X X X X X</pre> The university's administration wanted to secure themselves against cheating. Candidates in the same language were to be completely isolated from each other - so much so that their cells were not to coincide even at the corners. A young lecturer was given the job of finding a solution to the problem, which he did, and justly received a pat on the back from the dean. Now it just so happens that the dean is an ardent prolog programmer in his spare time (how else could he make dean?) and, realizing that there could be several solutions to the problem, used his skills to find all solutions. Can you do the same? </blockquote> ===Note=== &quot;Several solutions&quot; doesn't really cover it! Assuming that by 'a solution' we mean finding a mapping between candidates and cells, then, having found one such solution, we can find 955,514,879 other members of its solution &quot;family&quot; quite easily, through: * ''candidate permutation'': There are (4!)⁵ permutations of the candidates within the cells allocated to their subjects; * ''subject permutation'': we can multiply the 'candidate permutations' by the 5! permutations of the subjects allocated to particular sets of cells. This means that the total number of solutions is 955514880 &times; D where D is the number of solution families i.e. solutions that cannot be derived from each other by candidate or subject permutation. Finding [[#Result|D]] is the more interesting problem solved by this program. ====nut1( ?Solutions )==== <var>Solutions</var> is the number of distinct solutions to the subject/cell allocation problem for any five different subjects. <syntaxhighlight lang="prolog">nut1( Solutions ) :- Norwegian = 1, German = 2, English = 3, French = 4, Spanish = 5, candidates( [Norwegian,German,English,French,Spanish], Candidates ), matrix( Cells ), findall( x, % We don't care about the actual solution allocate(Cells, Candidates), Allocations ), length( Allocations, Solutions ).</syntaxhighlight> ====allocate( +Cells, +Candidates )==== holds when each cell in <var>Cells</var> holds a candidate from <var>Candidates</var>. <syntaxhighlight lang="prolog">allocate( Cells, Candidates ) :- allocation( Cells, 1, Candidates ).</syntaxhighlight> ====allocation( +Cells, +NextSubject, +Subjects )==== holds when <var>Cells</var> is a representation of a distinct solution to the subject/cell allocation problem. <var>NextSubject</var> is the highest subject that can be allocated next, while <var>Subjects</var> is the list of subjects needing allocation to <var>Cells</var>. Each subject is represented by a list, in which each occurrence of the subject number represents a candidate. We guarantee distinct solutions by ensuring that the allocation is made on the following basis: * For each subject: the location of the N+1th candidate must be a successor of the location of the Nth candidate - to eliminate 'candidate permutations'. * The location of the first candidate of the N+1th subject must be a successor of the location of the first candidate of the Nth subject - to eliminate 'subject permutations'. Operationally, at each step we select a candidate for a cell and constrain all the cell's adjacent successors to have different subject(s) from it. <syntaxhighlight lang="prolog">allocation( [], _Next, [] ). allocation( [Cell|Cells], Next, Subjects ) :- allocate_candidate( Subjects, Next, Candidate, Subjects1, Next1 ), cell( Candidate, Cell ), adjacent_successors( Cell, AdjacentSuccessors ), blocked( AdjacentSuccessors, Candidate ), allocation( Cells, Next1, Subjects1 ).</syntaxhighlight> allocate_candidate( +Subjects, +Next, ?Candidate, ?Subjects1, ?Next1 ) holds when Candidate is taken from Subjects leaving Subjects1. Candidate is represented by a subject number <code>=&lt;</code> Next. Next1 is the highest subject that can be allocated to the next cell, ensuring that the first candidate for each subject is allocated in order. <syntaxhighlight lang="prolog">allocate_candidate( [Subject|Subjects], Next, Candidate, Subjects1, Next1 ) :- Subject = [Candidate|Candidates], Candidate =&lt; Next, Next1 is max(Candidate+1,Next), residual_candidates( Candidates, Subjects, Subjects1 ). allocate_candidate( [Subject|Subjects], Next, Candidate, [Subject|Subjects1], Next1 ) :- Subject = [Candidate0|_Candidates], Candidate0 &lt; Next, allocate_candidate( Subjects, Next, Candidate, Subjects1, Next1 ). residual_candidates( [], Subjects, Subjects ). residual_candidates( Candidates, Subjects, [Candidates|Subjects] ) :- Candidates = [_|_].</syntaxhighlight> ====matrix( ?Matrix )==== holds when Matrix is a list of 'cells' ordered by their (x,y) coordinates. Each 'cell' is described by 5 binary digits, which indicate the subject assigned to it, and the set of successors of the cell that are adjacent to it. <syntaxhighlight lang="prolog">matrix( Matrix ) :- layout( Layout ), matrix1( Layout, _Index, Matrix ). matrix1( [], _Index, [] ). matrix1( [(Row, Column)|Layout], Index, [Cell|Matrix] ) :- location_cell( Row, Column, Index, Cell ), findall( (Row1, Column1), ( successor( (Row, Column), (Row1, Column1) ), adjacent(Row, Row1), adjacent(Column, Column1) ), AdjacentSuccessorLocations ), location_cells( AdjacentSuccessorLocations, Index, AdjacentSuccessors ), adjacent_successors( Cell, AdjacentSuccessors ), matrix1( Layout, Index, Matrix ).</syntaxhighlight> ====cell( ?Subject, ?Cell )==== holds when <var>Cell</var> is the cell representation for <var>Subject</var>. <syntaxhighlight lang="prolog">cell( 1, cell(1,0,0,0,0,_) ). cell( 2, cell(0,1,0,0,0,_) ). cell( 3, cell(0,0,1,0,0,_) ). cell( 4, cell(0,0,0,1,0,_) ). cell( 5, cell(0,0,0,0,1,_) ).</syntaxhighlight> ====block( ?Subject, ?Block )==== holds when <var>Block</var> is a cell representation that is incompatible with <var>Subject</var>. <syntaxhighlight lang="prolog">block( 1, cell(0,_,_,_,_,_) ). block( 2, cell(_,0,_,_,_,_) ). block( 3, cell(_,_,0,_,_,_) ). block( 4, cell(_,_,_,0,_,_) ). block( 5, cell(_,_,_,_,0,_) ).</syntaxhighlight> ====adjacent_successors( ?Cell, ?AdjacentSuccesors )==== holds when <var>AdjacentSuccesors</var> is the set of successors of <var>Cell</var> that are adjacent to it. <syntaxhighlight lang="prolog">adjacent_successors( cell(_,_,_,_,_,AdjacentSuccesors), AdjacentSuccesors ).</syntaxhighlight> ====blocked( +Blocked, ?Subject )==== holds when all the cells in <var>Blocked</var> are incompatible with <var>Subject</var>. <syntaxhighlight lang="prolog">blocked( [], _Subject ). blocked( [Cell|Blocked], Subject ) :- block( Subject, Cell ), blocked( Blocked, Subject ).</syntaxhighlight> ====adjacent( +Coordinate0, ?Coordinate1 )==== holds when <var>Coordinate0</var> and <var>Coordinate1</var> are the same or differ by 1. <syntaxhighlight lang="prolog">adjacent( N, N ). adjacent( N0, N1 ) :- N1 is N0 + 1. adjacent( N0, N1 ) :- N1 is N0 - 1.</syntaxhighlight> ====location_cells( ?Locations, ?Index, ?Cells )==== holds when <var>Index</var> is a 6 &times; 6 array, <var>Locations</var> is a list of (Row,Column) pairs and <var>Cells</var> is the list of matching cells dereferenced from <var>Index</var>. <syntaxhighlight lang="prolog">location_cells( [], _Index, [] ). location_cells( [(Row, Column)|Locs], Index, [Cell|Cells] ) :- location_cell( Row, Column, Index, Cell ), location_cells( Locs, Index, Cells ).</syntaxhighlight> ====location_cell( ?Row, ?Column, ?Index, ?Cell )==== holds when <var>Index</var> is a 6 &times; 6 array with <var>Cell</var> at location (<var>Row</var>,<var>Column</var>). <syntaxhighlight lang="prolog">location_cell( Row, Column, Index, Cell ) :- select_nth( Row, Index, IndexRow ), select_nth( Column, IndexRow, Cell ).</syntaxhighlight> ====select_nth( ?N, ?Array, ?Element )==== holds when <var>Element</var> is the <var>N</var>th element of <var>Array</var>. <syntaxhighlight lang="prolog">select_nth( 1, array_6(A,_B,_C,_D,_E,_F), A ). select_nth( 2, array_6(_A,B,_C,_D,_E,_F), B ). select_nth( 3, array_6(_A,_B,C,_D,_E,_F), C ). select_nth( 4, array_6(_A,_B,_C,D,_E,_F), D ). select_nth( 5, array_6(_A,_B,_C,_D,E,_F), E ). select_nth( 6, array_6(_A,_B,_C,_D,_E,F), F ).</syntaxhighlight> ====successor( ?Coordinates0, ?Coordinates1 )==== holds when <var>Coordinates0</var> and <var>Coordinates1</var> are valid cell positions and <var>Coordinates0</var> &lt;<var>Coordinates1</var>. <syntaxhighlight lang="prolog">successor( Coordinates0, Coordinates1 ) :- layout( Layout ), append( _Prefix, [Coordinates0|Successors], Layout ), member( Coordinates1, Successors ).</syntaxhighlight> ====candidates( ?Subjects, ?Candidates )==== holds when there are 4 <var>Candidates</var> for each <var>Subject</var>. <syntaxhighlight lang="prolog">candidates( [], [] ). candidates( [Subj|Subjects], [[Subj,Subj,Subj,Subj]|Candidates] ) :- candidates( Subjects, Candidates ).</syntaxhighlight> ====layout( ?Layout )==== holds when Layout is the sequence of all (x,y) co-ordinates of valid 'cells'. <syntaxhighlight lang="prolog">layout( [ (1,2), (2,2),(2,3),(2,4),(2,5),(2,6), (3,2),(3,3),(3,4),(3,5), (4,2),(4,3),(4,4),(4,5), (5,1),(5,2),(5,3),(5,4),(5,5), (6,5) ] ).</syntaxhighlight> Load a small library of [[puzzle utilities]] <syntaxhighlight lang="prolog">:- ensure_loaded( misc ).</syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/download/nut1.txt here]. === Result === This program reports 29870 solutions. 04e97eb766f5bf39247bf37ed500fdf1e4ff2fd7 35 33 2013-10-13T21:59:27Z John 2 /* layout( ?Layout ) */ wikitext text/x-wiki ==Constrained Permutations in Prolog== __NOTOC__ Problem posted to [http://groups.google.com/group/comp.lang.prolog/msg/a984ea325e0a4180 comp.lang.prolog] by Daniel Dudley ===Problem Statement=== <blockquote>A university was to hold an examination in 5 subjects: Norwegian, German, English, French and Spanish. In each of these languages there were 4 candidates. The examination room was therefore divided into 20 cells, as shown in the figure below (view this in a fixed font): <pre> X X X X X X X X X X X X X X X X X X X X</pre> The university's administration wanted to secure themselves against cheating. Candidates in the same language were to be completely isolated from each other - so much so that their cells were not to coincide even at the corners. A young lecturer was given the job of finding a solution to the problem, which he did, and justly received a pat on the back from the dean. Now it just so happens that the dean is an ardent prolog programmer in his spare time (how else could he make dean?) and, realizing that there could be several solutions to the problem, used his skills to find all solutions. Can you do the same? </blockquote> ===Note=== &quot;Several solutions&quot; doesn't really cover it! Assuming that by 'a solution' we mean finding a mapping between candidates and cells, then, having found one such solution, we can find 955,514,879 other members of its solution &quot;family&quot; quite easily, through: * ''candidate permutation'': There are (4!)⁵ permutations of the candidates within the cells allocated to their subjects; * ''subject permutation'': we can multiply the 'candidate permutations' by the 5! permutations of the subjects allocated to particular sets of cells. This means that the total number of solutions is 955514880 &times; D where D is the number of solution families i.e. solutions that cannot be derived from each other by candidate or subject permutation. Finding [[#Result|D]] is the more interesting problem solved by this program. ====nut1( ?Solutions )==== <var>Solutions</var> is the number of distinct solutions to the subject/cell allocation problem for any five different subjects. <syntaxhighlight lang="prolog">nut1( Solutions ) :- Norwegian = 1, German = 2, English = 3, French = 4, Spanish = 5, candidates( [Norwegian,German,English,French,Spanish], Candidates ), matrix( Cells ), findall( x, % We don't care about the actual solution allocate(Cells, Candidates), Allocations ), length( Allocations, Solutions ).</syntaxhighlight> ====allocate( +Cells, +Candidates )==== holds when each cell in <var>Cells</var> holds a candidate from <var>Candidates</var>. <syntaxhighlight lang="prolog">allocate( Cells, Candidates ) :- allocation( Cells, 1, Candidates ).</syntaxhighlight> ====allocation( +Cells, +NextSubject, +Subjects )==== holds when <var>Cells</var> is a representation of a distinct solution to the subject/cell allocation problem. <var>NextSubject</var> is the highest subject that can be allocated next, while <var>Subjects</var> is the list of subjects needing allocation to <var>Cells</var>. Each subject is represented by a list, in which each occurrence of the subject number represents a candidate. We guarantee distinct solutions by ensuring that the allocation is made on the following basis: * For each subject: the location of the N+1th candidate must be a successor of the location of the Nth candidate - to eliminate 'candidate permutations'. * The location of the first candidate of the N+1th subject must be a successor of the location of the first candidate of the Nth subject - to eliminate 'subject permutations'. Operationally, at each step we select a candidate for a cell and constrain all the cell's adjacent successors to have different subject(s) from it. <syntaxhighlight lang="prolog">allocation( [], _Next, [] ). allocation( [Cell|Cells], Next, Subjects ) :- allocate_candidate( Subjects, Next, Candidate, Subjects1, Next1 ), cell( Candidate, Cell ), adjacent_successors( Cell, AdjacentSuccessors ), blocked( AdjacentSuccessors, Candidate ), allocation( Cells, Next1, Subjects1 ).</syntaxhighlight> allocate_candidate( +Subjects, +Next, ?Candidate, ?Subjects1, ?Next1 ) holds when Candidate is taken from Subjects leaving Subjects1. Candidate is represented by a subject number <code>=&lt;</code> Next. Next1 is the highest subject that can be allocated to the next cell, ensuring that the first candidate for each subject is allocated in order. <syntaxhighlight lang="prolog">allocate_candidate( [Subject|Subjects], Next, Candidate, Subjects1, Next1 ) :- Subject = [Candidate|Candidates], Candidate =&lt; Next, Next1 is max(Candidate+1,Next), residual_candidates( Candidates, Subjects, Subjects1 ). allocate_candidate( [Subject|Subjects], Next, Candidate, [Subject|Subjects1], Next1 ) :- Subject = [Candidate0|_Candidates], Candidate0 &lt; Next, allocate_candidate( Subjects, Next, Candidate, Subjects1, Next1 ). residual_candidates( [], Subjects, Subjects ). residual_candidates( Candidates, Subjects, [Candidates|Subjects] ) :- Candidates = [_|_].</syntaxhighlight> ====matrix( ?Matrix )==== holds when Matrix is a list of 'cells' ordered by their (x,y) coordinates. Each 'cell' is described by 5 binary digits, which indicate the subject assigned to it, and the set of successors of the cell that are adjacent to it. <syntaxhighlight lang="prolog">matrix( Matrix ) :- layout( Layout ), matrix1( Layout, _Index, Matrix ). matrix1( [], _Index, [] ). matrix1( [(Row, Column)|Layout], Index, [Cell|Matrix] ) :- location_cell( Row, Column, Index, Cell ), findall( (Row1, Column1), ( successor( (Row, Column), (Row1, Column1) ), adjacent(Row, Row1), adjacent(Column, Column1) ), AdjacentSuccessorLocations ), location_cells( AdjacentSuccessorLocations, Index, AdjacentSuccessors ), adjacent_successors( Cell, AdjacentSuccessors ), matrix1( Layout, Index, Matrix ).</syntaxhighlight> ====cell( ?Subject, ?Cell )==== holds when <var>Cell</var> is the cell representation for <var>Subject</var>. <syntaxhighlight lang="prolog">cell( 1, cell(1,0,0,0,0,_) ). cell( 2, cell(0,1,0,0,0,_) ). cell( 3, cell(0,0,1,0,0,_) ). cell( 4, cell(0,0,0,1,0,_) ). cell( 5, cell(0,0,0,0,1,_) ).</syntaxhighlight> ====block( ?Subject, ?Block )==== holds when <var>Block</var> is a cell representation that is incompatible with <var>Subject</var>. <syntaxhighlight lang="prolog">block( 1, cell(0,_,_,_,_,_) ). block( 2, cell(_,0,_,_,_,_) ). block( 3, cell(_,_,0,_,_,_) ). block( 4, cell(_,_,_,0,_,_) ). block( 5, cell(_,_,_,_,0,_) ).</syntaxhighlight> ====adjacent_successors( ?Cell, ?AdjacentSuccesors )==== holds when <var>AdjacentSuccesors</var> is the set of successors of <var>Cell</var> that are adjacent to it. <syntaxhighlight lang="prolog">adjacent_successors( cell(_,_,_,_,_,AdjacentSuccesors), AdjacentSuccesors ).</syntaxhighlight> ====blocked( +Blocked, ?Subject )==== holds when all the cells in <var>Blocked</var> are incompatible with <var>Subject</var>. <syntaxhighlight lang="prolog">blocked( [], _Subject ). blocked( [Cell|Blocked], Subject ) :- block( Subject, Cell ), blocked( Blocked, Subject ).</syntaxhighlight> ====adjacent( +Coordinate0, ?Coordinate1 )==== holds when <var>Coordinate0</var> and <var>Coordinate1</var> are the same or differ by 1. <syntaxhighlight lang="prolog">adjacent( N, N ). adjacent( N0, N1 ) :- N1 is N0 + 1. adjacent( N0, N1 ) :- N1 is N0 - 1.</syntaxhighlight> ====location_cells( ?Locations, ?Index, ?Cells )==== holds when <var>Index</var> is a 6 &times; 6 array, <var>Locations</var> is a list of (Row,Column) pairs and <var>Cells</var> is the list of matching cells dereferenced from <var>Index</var>. <syntaxhighlight lang="prolog">location_cells( [], _Index, [] ). location_cells( [(Row, Column)|Locs], Index, [Cell|Cells] ) :- location_cell( Row, Column, Index, Cell ), location_cells( Locs, Index, Cells ).</syntaxhighlight> ====location_cell( ?Row, ?Column, ?Index, ?Cell )==== holds when <var>Index</var> is a 6 &times; 6 array with <var>Cell</var> at location (<var>Row</var>,<var>Column</var>). <syntaxhighlight lang="prolog">location_cell( Row, Column, Index, Cell ) :- select_nth( Row, Index, IndexRow ), select_nth( Column, IndexRow, Cell ).</syntaxhighlight> ====select_nth( ?N, ?Array, ?Element )==== holds when <var>Element</var> is the <var>N</var>th element of <var>Array</var>. <syntaxhighlight lang="prolog">select_nth( 1, array_6(A,_B,_C,_D,_E,_F), A ). select_nth( 2, array_6(_A,B,_C,_D,_E,_F), B ). select_nth( 3, array_6(_A,_B,C,_D,_E,_F), C ). select_nth( 4, array_6(_A,_B,_C,D,_E,_F), D ). select_nth( 5, array_6(_A,_B,_C,_D,E,_F), E ). select_nth( 6, array_6(_A,_B,_C,_D,_E,F), F ).</syntaxhighlight> ====successor( ?Coordinates0, ?Coordinates1 )==== holds when <var>Coordinates0</var> and <var>Coordinates1</var> are valid cell positions and <var>Coordinates0</var> &lt;<var>Coordinates1</var>. <syntaxhighlight lang="prolog">successor( Coordinates0, Coordinates1 ) :- layout( Layout ), append( _Prefix, [Coordinates0|Successors], Layout ), member( Coordinates1, Successors ).</syntaxhighlight> ====candidates( ?Subjects, ?Candidates )==== holds when there are 4 <var>Candidates</var> for each <var>Subject</var>. <syntaxhighlight lang="prolog">candidates( [], [] ). candidates( [Subj|Subjects], [[Subj,Subj,Subj,Subj]|Candidates] ) :- candidates( Subjects, Candidates ).</syntaxhighlight> ====layout( ?Layout )==== holds when Layout is the sequence of all (x,y) co-ordinates of valid 'cells'. <syntaxhighlight lang="prolog">layout( [ (1,2), (2,2),(2,3),(2,4),(2,5),(2,6), (3,2),(3,3),(3,4),(3,5), (4,2),(4,3),(4,4),(4,5), (5,1),(5,2),(5,3),(5,4),(5,5), (6,5) ] ).</syntaxhighlight> Load a small library of [https://binding-time.co.uk/misc.html puzzle utilities]. <syntaxhighlight lang="prolog">:- ensure_loaded( misc ).</syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/download/nut1.txt here]. === Result === This program reports 29870 solutions. 9f6d1255fb0a1ffbca17409c80c9130481b30a6c 36 35 2013-10-13T22:07:44Z John 2 John moved page [[Cheating Linguists?]] to [[Cheating Linguists]]: Ambiguous URL treatment. wikitext text/x-wiki ==Constrained Permutations in Prolog== __NOTOC__ Problem posted to [http://groups.google.com/group/comp.lang.prolog/msg/a984ea325e0a4180 comp.lang.prolog] by Daniel Dudley ===Problem Statement=== <blockquote>A university was to hold an examination in 5 subjects: Norwegian, German, English, French and Spanish. In each of these languages there were 4 candidates. The examination room was therefore divided into 20 cells, as shown in the figure below (view this in a fixed font): <pre> X X X X X X X X X X X X X X X X X X X X</pre> The university's administration wanted to secure themselves against cheating. Candidates in the same language were to be completely isolated from each other - so much so that their cells were not to coincide even at the corners. A young lecturer was given the job of finding a solution to the problem, which he did, and justly received a pat on the back from the dean. Now it just so happens that the dean is an ardent prolog programmer in his spare time (how else could he make dean?) and, realizing that there could be several solutions to the problem, used his skills to find all solutions. Can you do the same? </blockquote> ===Note=== &quot;Several solutions&quot; doesn't really cover it! Assuming that by 'a solution' we mean finding a mapping between candidates and cells, then, having found one such solution, we can find 955,514,879 other members of its solution &quot;family&quot; quite easily, through: * ''candidate permutation'': There are (4!)⁵ permutations of the candidates within the cells allocated to their subjects; * ''subject permutation'': we can multiply the 'candidate permutations' by the 5! permutations of the subjects allocated to particular sets of cells. This means that the total number of solutions is 955514880 &times; D where D is the number of solution families i.e. solutions that cannot be derived from each other by candidate or subject permutation. Finding [[#Result|D]] is the more interesting problem solved by this program. ====nut1( ?Solutions )==== <var>Solutions</var> is the number of distinct solutions to the subject/cell allocation problem for any five different subjects. <syntaxhighlight lang="prolog">nut1( Solutions ) :- Norwegian = 1, German = 2, English = 3, French = 4, Spanish = 5, candidates( [Norwegian,German,English,French,Spanish], Candidates ), matrix( Cells ), findall( x, % We don't care about the actual solution allocate(Cells, Candidates), Allocations ), length( Allocations, Solutions ).</syntaxhighlight> ====allocate( +Cells, +Candidates )==== holds when each cell in <var>Cells</var> holds a candidate from <var>Candidates</var>. <syntaxhighlight lang="prolog">allocate( Cells, Candidates ) :- allocation( Cells, 1, Candidates ).</syntaxhighlight> ====allocation( +Cells, +NextSubject, +Subjects )==== holds when <var>Cells</var> is a representation of a distinct solution to the subject/cell allocation problem. <var>NextSubject</var> is the highest subject that can be allocated next, while <var>Subjects</var> is the list of subjects needing allocation to <var>Cells</var>. Each subject is represented by a list, in which each occurrence of the subject number represents a candidate. We guarantee distinct solutions by ensuring that the allocation is made on the following basis: * For each subject: the location of the N+1th candidate must be a successor of the location of the Nth candidate - to eliminate 'candidate permutations'. * The location of the first candidate of the N+1th subject must be a successor of the location of the first candidate of the Nth subject - to eliminate 'subject permutations'. Operationally, at each step we select a candidate for a cell and constrain all the cell's adjacent successors to have different subject(s) from it. <syntaxhighlight lang="prolog">allocation( [], _Next, [] ). allocation( [Cell|Cells], Next, Subjects ) :- allocate_candidate( Subjects, Next, Candidate, Subjects1, Next1 ), cell( Candidate, Cell ), adjacent_successors( Cell, AdjacentSuccessors ), blocked( AdjacentSuccessors, Candidate ), allocation( Cells, Next1, Subjects1 ).</syntaxhighlight> allocate_candidate( +Subjects, +Next, ?Candidate, ?Subjects1, ?Next1 ) holds when Candidate is taken from Subjects leaving Subjects1. Candidate is represented by a subject number <code>=&lt;</code> Next. Next1 is the highest subject that can be allocated to the next cell, ensuring that the first candidate for each subject is allocated in order. <syntaxhighlight lang="prolog">allocate_candidate( [Subject|Subjects], Next, Candidate, Subjects1, Next1 ) :- Subject = [Candidate|Candidates], Candidate =&lt; Next, Next1 is max(Candidate+1,Next), residual_candidates( Candidates, Subjects, Subjects1 ). allocate_candidate( [Subject|Subjects], Next, Candidate, [Subject|Subjects1], Next1 ) :- Subject = [Candidate0|_Candidates], Candidate0 &lt; Next, allocate_candidate( Subjects, Next, Candidate, Subjects1, Next1 ). residual_candidates( [], Subjects, Subjects ). residual_candidates( Candidates, Subjects, [Candidates|Subjects] ) :- Candidates = [_|_].</syntaxhighlight> ====matrix( ?Matrix )==== holds when Matrix is a list of 'cells' ordered by their (x,y) coordinates. Each 'cell' is described by 5 binary digits, which indicate the subject assigned to it, and the set of successors of the cell that are adjacent to it. <syntaxhighlight lang="prolog">matrix( Matrix ) :- layout( Layout ), matrix1( Layout, _Index, Matrix ). matrix1( [], _Index, [] ). matrix1( [(Row, Column)|Layout], Index, [Cell|Matrix] ) :- location_cell( Row, Column, Index, Cell ), findall( (Row1, Column1), ( successor( (Row, Column), (Row1, Column1) ), adjacent(Row, Row1), adjacent(Column, Column1) ), AdjacentSuccessorLocations ), location_cells( AdjacentSuccessorLocations, Index, AdjacentSuccessors ), adjacent_successors( Cell, AdjacentSuccessors ), matrix1( Layout, Index, Matrix ).</syntaxhighlight> ====cell( ?Subject, ?Cell )==== holds when <var>Cell</var> is the cell representation for <var>Subject</var>. <syntaxhighlight lang="prolog">cell( 1, cell(1,0,0,0,0,_) ). cell( 2, cell(0,1,0,0,0,_) ). cell( 3, cell(0,0,1,0,0,_) ). cell( 4, cell(0,0,0,1,0,_) ). cell( 5, cell(0,0,0,0,1,_) ).</syntaxhighlight> ====block( ?Subject, ?Block )==== holds when <var>Block</var> is a cell representation that is incompatible with <var>Subject</var>. <syntaxhighlight lang="prolog">block( 1, cell(0,_,_,_,_,_) ). block( 2, cell(_,0,_,_,_,_) ). block( 3, cell(_,_,0,_,_,_) ). block( 4, cell(_,_,_,0,_,_) ). block( 5, cell(_,_,_,_,0,_) ).</syntaxhighlight> ====adjacent_successors( ?Cell, ?AdjacentSuccesors )==== holds when <var>AdjacentSuccesors</var> is the set of successors of <var>Cell</var> that are adjacent to it. <syntaxhighlight lang="prolog">adjacent_successors( cell(_,_,_,_,_,AdjacentSuccesors), AdjacentSuccesors ).</syntaxhighlight> ====blocked( +Blocked, ?Subject )==== holds when all the cells in <var>Blocked</var> are incompatible with <var>Subject</var>. <syntaxhighlight lang="prolog">blocked( [], _Subject ). blocked( [Cell|Blocked], Subject ) :- block( Subject, Cell ), blocked( Blocked, Subject ).</syntaxhighlight> ====adjacent( +Coordinate0, ?Coordinate1 )==== holds when <var>Coordinate0</var> and <var>Coordinate1</var> are the same or differ by 1. <syntaxhighlight lang="prolog">adjacent( N, N ). adjacent( N0, N1 ) :- N1 is N0 + 1. adjacent( N0, N1 ) :- N1 is N0 - 1.</syntaxhighlight> ====location_cells( ?Locations, ?Index, ?Cells )==== holds when <var>Index</var> is a 6 &times; 6 array, <var>Locations</var> is a list of (Row,Column) pairs and <var>Cells</var> is the list of matching cells dereferenced from <var>Index</var>. <syntaxhighlight lang="prolog">location_cells( [], _Index, [] ). location_cells( [(Row, Column)|Locs], Index, [Cell|Cells] ) :- location_cell( Row, Column, Index, Cell ), location_cells( Locs, Index, Cells ).</syntaxhighlight> ====location_cell( ?Row, ?Column, ?Index, ?Cell )==== holds when <var>Index</var> is a 6 &times; 6 array with <var>Cell</var> at location (<var>Row</var>,<var>Column</var>). <syntaxhighlight lang="prolog">location_cell( Row, Column, Index, Cell ) :- select_nth( Row, Index, IndexRow ), select_nth( Column, IndexRow, Cell ).</syntaxhighlight> ====select_nth( ?N, ?Array, ?Element )==== holds when <var>Element</var> is the <var>N</var>th element of <var>Array</var>. <syntaxhighlight lang="prolog">select_nth( 1, array_6(A,_B,_C,_D,_E,_F), A ). select_nth( 2, array_6(_A,B,_C,_D,_E,_F), B ). select_nth( 3, array_6(_A,_B,C,_D,_E,_F), C ). select_nth( 4, array_6(_A,_B,_C,D,_E,_F), D ). select_nth( 5, array_6(_A,_B,_C,_D,E,_F), E ). select_nth( 6, array_6(_A,_B,_C,_D,_E,F), F ).</syntaxhighlight> ====successor( ?Coordinates0, ?Coordinates1 )==== holds when <var>Coordinates0</var> and <var>Coordinates1</var> are valid cell positions and <var>Coordinates0</var> &lt;<var>Coordinates1</var>. <syntaxhighlight lang="prolog">successor( Coordinates0, Coordinates1 ) :- layout( Layout ), append( _Prefix, [Coordinates0|Successors], Layout ), member( Coordinates1, Successors ).</syntaxhighlight> ====candidates( ?Subjects, ?Candidates )==== holds when there are 4 <var>Candidates</var> for each <var>Subject</var>. <syntaxhighlight lang="prolog">candidates( [], [] ). candidates( [Subj|Subjects], [[Subj,Subj,Subj,Subj]|Candidates] ) :- candidates( Subjects, Candidates ).</syntaxhighlight> ====layout( ?Layout )==== holds when Layout is the sequence of all (x,y) co-ordinates of valid 'cells'. <syntaxhighlight lang="prolog">layout( [ (1,2), (2,2),(2,3),(2,4),(2,5),(2,6), (3,2),(3,3),(3,4),(3,5), (4,2),(4,3),(4,4),(4,5), (5,1),(5,2),(5,3),(5,4),(5,5), (6,5) ] ).</syntaxhighlight> Load a small library of [https://binding-time.co.uk/misc.html puzzle utilities]. <syntaxhighlight lang="prolog">:- ensure_loaded( misc ).</syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/download/nut1.txt here]. === Result === This program reports 29870 solutions. 9f6d1255fb0a1ffbca17409c80c9130481b30a6c 39 36 2013-10-14T09:02:52Z John 2 /* allocate_candidate( +Subjects, +Next, ?Candidate, ?Subjects1, ?Next1 ) */ wikitext text/x-wiki ==Constrained Permutations in Prolog== __NOTOC__ Problem posted to [http://groups.google.com/group/comp.lang.prolog/msg/a984ea325e0a4180 comp.lang.prolog] by Daniel Dudley ===Problem Statement=== <blockquote>A university was to hold an examination in 5 subjects: Norwegian, German, English, French and Spanish. In each of these languages there were 4 candidates. The examination room was therefore divided into 20 cells, as shown in the figure below (view this in a fixed font): <pre> X X X X X X X X X X X X X X X X X X X X</pre> The university's administration wanted to secure themselves against cheating. Candidates in the same language were to be completely isolated from each other - so much so that their cells were not to coincide even at the corners. A young lecturer was given the job of finding a solution to the problem, which he did, and justly received a pat on the back from the dean. Now it just so happens that the dean is an ardent prolog programmer in his spare time (how else could he make dean?) and, realizing that there could be several solutions to the problem, used his skills to find all solutions. Can you do the same? </blockquote> ===Note=== &quot;Several solutions&quot; doesn't really cover it! Assuming that by 'a solution' we mean finding a mapping between candidates and cells, then, having found one such solution, we can find 955,514,879 other members of its solution &quot;family&quot; quite easily, through: * ''candidate permutation'': There are (4!)⁵ permutations of the candidates within the cells allocated to their subjects; * ''subject permutation'': we can multiply the 'candidate permutations' by the 5! permutations of the subjects allocated to particular sets of cells. This means that the total number of solutions is 955514880 &times; D where D is the number of solution families i.e. solutions that cannot be derived from each other by candidate or subject permutation. Finding [[#Result|D]] is the more interesting problem solved by this program. ====nut1( ?Solutions )==== <var>Solutions</var> is the number of distinct solutions to the subject/cell allocation problem for any five different subjects. <syntaxhighlight lang="prolog">nut1( Solutions ) :- Norwegian = 1, German = 2, English = 3, French = 4, Spanish = 5, candidates( [Norwegian,German,English,French,Spanish], Candidates ), matrix( Cells ), findall( x, % We don't care about the actual solution allocate(Cells, Candidates), Allocations ), length( Allocations, Solutions ).</syntaxhighlight> ====allocate( +Cells, +Candidates )==== holds when each cell in <var>Cells</var> holds a candidate from <var>Candidates</var>. <syntaxhighlight lang="prolog">allocate( Cells, Candidates ) :- allocation( Cells, 1, Candidates ).</syntaxhighlight> ====allocation( +Cells, +NextSubject, +Subjects )==== holds when <var>Cells</var> is a representation of a distinct solution to the subject/cell allocation problem. <var>NextSubject</var> is the highest subject that can be allocated next, while <var>Subjects</var> is the list of subjects needing allocation to <var>Cells</var>. Each subject is represented by a list, in which each occurrence of the subject number represents a candidate. We guarantee distinct solutions by ensuring that the allocation is made on the following basis: * For each subject: the location of the N+1th candidate must be a successor of the location of the Nth candidate - to eliminate 'candidate permutations'. * The location of the first candidate of the N+1th subject must be a successor of the location of the first candidate of the Nth subject - to eliminate 'subject permutations'. Operationally, at each step we select a candidate for a cell and constrain all the cell's adjacent successors to have different subject(s) from it. <syntaxhighlight lang="prolog">allocation( [], _Next, [] ). allocation( [Cell|Cells], Next, Subjects ) :- allocate_candidate( Subjects, Next, Candidate, Subjects1, Next1 ), cell( Candidate, Cell ), adjacent_successors( Cell, AdjacentSuccessors ), blocked( AdjacentSuccessors, Candidate ), allocation( Cells, Next1, Subjects1 ).</syntaxhighlight> ====allocate_candidate( +Subjects, +Next, ?Candidate, ?Subjects1, ?Next1 )==== holds when <var>Candidate</var> is taken from <var>Subjects</var> leaving <var>Subjects1</var>. <var>Candidate</var> is represented by a subject number <code>=<</code> <var>Next</var>. <var>Next1</var> is the highest subject that can be allocated to the next cell, ensuring that the first candidate for each subject is allocated in order. <syntaxhighlight lang="prolog">allocate_candidate( [Subject|Subjects], Next, Candidate, Subjects1, Next1 ) :- Subject = [Candidate|Candidates], Candidate =< Next, Next1 is max(Candidate+1,Next), residual_candidates( Candidates, Subjects, Subjects1 ). allocate_candidate( [Subject|Subjects], Next, Candidate, [Subject|Subjects1], Next1 ) :- Subject = [Candidate0|_Candidates], Candidate0 < Next, allocate_candidate( Subjects, Next, Candidate, Subjects1, Next1 ). residual_candidates( [], Subjects, Subjects ). residual_candidates( Candidates, Subjects, [Candidates|Subjects] ) :- Candidates = [_|_].</syntaxhighlight> ====matrix( ?Matrix )==== holds when Matrix is a list of 'cells' ordered by their (x,y) coordinates. Each 'cell' is described by 5 binary digits, which indicate the subject assigned to it, and the set of successors of the cell that are adjacent to it. <syntaxhighlight lang="prolog">matrix( Matrix ) :- layout( Layout ), matrix1( Layout, _Index, Matrix ). matrix1( [], _Index, [] ). matrix1( [(Row, Column)|Layout], Index, [Cell|Matrix] ) :- location_cell( Row, Column, Index, Cell ), findall( (Row1, Column1), ( successor( (Row, Column), (Row1, Column1) ), adjacent(Row, Row1), adjacent(Column, Column1) ), AdjacentSuccessorLocations ), location_cells( AdjacentSuccessorLocations, Index, AdjacentSuccessors ), adjacent_successors( Cell, AdjacentSuccessors ), matrix1( Layout, Index, Matrix ).</syntaxhighlight> ====cell( ?Subject, ?Cell )==== holds when <var>Cell</var> is the cell representation for <var>Subject</var>. <syntaxhighlight lang="prolog">cell( 1, cell(1,0,0,0,0,_) ). cell( 2, cell(0,1,0,0,0,_) ). cell( 3, cell(0,0,1,0,0,_) ). cell( 4, cell(0,0,0,1,0,_) ). cell( 5, cell(0,0,0,0,1,_) ).</syntaxhighlight> ====block( ?Subject, ?Block )==== holds when <var>Block</var> is a cell representation that is incompatible with <var>Subject</var>. <syntaxhighlight lang="prolog">block( 1, cell(0,_,_,_,_,_) ). block( 2, cell(_,0,_,_,_,_) ). block( 3, cell(_,_,0,_,_,_) ). block( 4, cell(_,_,_,0,_,_) ). block( 5, cell(_,_,_,_,0,_) ).</syntaxhighlight> ====adjacent_successors( ?Cell, ?AdjacentSuccesors )==== holds when <var>AdjacentSuccesors</var> is the set of successors of <var>Cell</var> that are adjacent to it. <syntaxhighlight lang="prolog">adjacent_successors( cell(_,_,_,_,_,AdjacentSuccesors), AdjacentSuccesors ).</syntaxhighlight> ====blocked( +Blocked, ?Subject )==== holds when all the cells in <var>Blocked</var> are incompatible with <var>Subject</var>. <syntaxhighlight lang="prolog">blocked( [], _Subject ). blocked( [Cell|Blocked], Subject ) :- block( Subject, Cell ), blocked( Blocked, Subject ).</syntaxhighlight> ====adjacent( +Coordinate0, ?Coordinate1 )==== holds when <var>Coordinate0</var> and <var>Coordinate1</var> are the same or differ by 1. <syntaxhighlight lang="prolog">adjacent( N, N ). adjacent( N0, N1 ) :- N1 is N0 + 1. adjacent( N0, N1 ) :- N1 is N0 - 1.</syntaxhighlight> ====location_cells( ?Locations, ?Index, ?Cells )==== holds when <var>Index</var> is a 6 &times; 6 array, <var>Locations</var> is a list of (Row,Column) pairs and <var>Cells</var> is the list of matching cells dereferenced from <var>Index</var>. <syntaxhighlight lang="prolog">location_cells( [], _Index, [] ). location_cells( [(Row, Column)|Locs], Index, [Cell|Cells] ) :- location_cell( Row, Column, Index, Cell ), location_cells( Locs, Index, Cells ).</syntaxhighlight> ====location_cell( ?Row, ?Column, ?Index, ?Cell )==== holds when <var>Index</var> is a 6 &times; 6 array with <var>Cell</var> at location (<var>Row</var>,<var>Column</var>). <syntaxhighlight lang="prolog">location_cell( Row, Column, Index, Cell ) :- select_nth( Row, Index, IndexRow ), select_nth( Column, IndexRow, Cell ).</syntaxhighlight> ====select_nth( ?N, ?Array, ?Element )==== holds when <var>Element</var> is the <var>N</var>th element of <var>Array</var>. <syntaxhighlight lang="prolog">select_nth( 1, array_6(A,_B,_C,_D,_E,_F), A ). select_nth( 2, array_6(_A,B,_C,_D,_E,_F), B ). select_nth( 3, array_6(_A,_B,C,_D,_E,_F), C ). select_nth( 4, array_6(_A,_B,_C,D,_E,_F), D ). select_nth( 5, array_6(_A,_B,_C,_D,E,_F), E ). select_nth( 6, array_6(_A,_B,_C,_D,_E,F), F ).</syntaxhighlight> ====successor( ?Coordinates0, ?Coordinates1 )==== holds when <var>Coordinates0</var> and <var>Coordinates1</var> are valid cell positions and <var>Coordinates0</var> &lt;<var>Coordinates1</var>. <syntaxhighlight lang="prolog">successor( Coordinates0, Coordinates1 ) :- layout( Layout ), append( _Prefix, [Coordinates0|Successors], Layout ), member( Coordinates1, Successors ).</syntaxhighlight> ====candidates( ?Subjects, ?Candidates )==== holds when there are 4 <var>Candidates</var> for each <var>Subject</var>. <syntaxhighlight lang="prolog">candidates( [], [] ). candidates( [Subj|Subjects], [[Subj,Subj,Subj,Subj]|Candidates] ) :- candidates( Subjects, Candidates ).</syntaxhighlight> ====layout( ?Layout )==== holds when Layout is the sequence of all (x,y) co-ordinates of valid 'cells'. <syntaxhighlight lang="prolog">layout( [ (1,2), (2,2),(2,3),(2,4),(2,5),(2,6), (3,2),(3,3),(3,4),(3,5), (4,2),(4,3),(4,4),(4,5), (5,1),(5,2),(5,3),(5,4),(5,5), (6,5) ] ).</syntaxhighlight> Load a small library of [https://binding-time.co.uk/misc.html puzzle utilities]. <syntaxhighlight lang="prolog">:- ensure_loaded( misc ).</syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/download/nut1.txt here]. === Result === This program reports 29870 solutions. e813a4a6faf3ac3793b6d524cae434c36aa9f046 40 39 2013-10-14T09:10:32Z John 2 wikitext text/x-wiki ==Constrained Permutations in Prolog== __NOTOC__ Problem posted to [http://groups.google.com/group/comp.lang.prolog/msg/a984ea325e0a4180 comp.lang.prolog] by Daniel Dudley ===Problem Statement=== <blockquote>A university was to hold an examination in 5 subjects: Norwegian, German, English, French and Spanish. In each of these languages there were 4 candidates. The examination room was therefore divided into 20 cells, as shown in the figure below (view this in a fixed font): <pre> X X X X X X X X X X X X X X X X X X X X</pre> The university's administration wanted to secure themselves against cheating. Candidates in the same language were to be completely isolated from each other - so much so that their cells were not to coincide even at the corners. A young lecturer was given the job of finding a solution to the problem, which he did, and justly received a pat on the back from the dean. Now it just so happens that the dean is an ardent prolog programmer in his spare time (how else could he make dean?) and, realizing that there could be several solutions to the problem, used his skills to find all solutions. Can you do the same? </blockquote> ===Note=== &quot;Several solutions&quot; doesn't really cover it! Assuming that by 'a solution' we mean finding a mapping between candidates and cells, then, having found one such solution, we can find 955,514,879 other members of its solution &quot;family&quot; quite easily, through: * ''candidate permutation'': There are (4!)⁵ permutations of the candidates within the cells allocated to their subjects; * ''subject permutation'': we can multiply the 'candidate permutations' by the 5! permutations of the subjects allocated to particular sets of cells. This means that the total number of solutions is 955514880 &times; D where D is the number of solution families i.e. solutions that cannot be derived from each other by candidate or subject permutation. Finding [[#Result|D]] is the more interesting problem solved by this program. ====nut1( ?Solutions )==== <var>Solutions</var> is the number of distinct solutions to the subject/cell allocation problem for any five different subjects. <syntaxhighlight lang="prolog">nut1( Solutions ) :- Norwegian = 1, German = 2, English = 3, French = 4, Spanish = 5, candidates( [Norwegian,German,English,French,Spanish], Candidates ), matrix( Cells ), findall( x, % We don't care about the actual solution allocate(Cells, Candidates), Allocations ), length( Allocations, Solutions ).</syntaxhighlight> ====allocate( +Cells, +Candidates )==== holds when each cell in <var>Cells</var> holds a candidate from <var>Candidates</var>. <syntaxhighlight lang="prolog">allocate( Cells, Candidates ) :- allocation( Cells, 1, Candidates ).</syntaxhighlight> ====allocation( +Cells, +NextSubject, +Subjects )==== holds when <var>Cells</var> is a representation of a distinct solution to the subject/cell allocation problem. <var>NextSubject</var> is the highest subject that can be allocated next, while <var>Subjects</var> is the list of subjects needing allocation to <var>Cells</var>. Each subject is represented by a list, in which each occurrence of the subject number represents a candidate. We guarantee distinct solutions by ensuring that the allocation is made on the following basis: * For each subject: the location of the N+1th candidate must be a successor of the location of the Nth candidate - to eliminate 'candidate permutations'. * The location of the first candidate of the N+1th subject must be a successor of the location of the first candidate of the Nth subject - to eliminate 'subject permutations'. Operationally, at each step we select a candidate for a cell and constrain all the cell's adjacent successors to have different subject(s) from it. <syntaxhighlight lang="prolog">allocation( [], _Next, [] ). allocation( [Cell|Cells], Next, Subjects ) :- allocate_candidate( Subjects, Next, Candidate, Subjects1, Next1 ), cell( Candidate, Cell ), adjacent_successors( Cell, AdjacentSuccessors ), blocked( AdjacentSuccessors, Candidate ), allocation( Cells, Next1, Subjects1 ).</syntaxhighlight> ====allocate_candidate( +Subjects, +Next, ?Candidate, ?Subjects1, ?Next1 )==== holds when <var>Candidate</var> is taken from <var>Subjects</var> leaving <var>Subjects1</var>. <var>Candidate</var> is represented by a subject number <code>=<</code> <var>Next</var>. <var>Next1</var> is the highest subject that can be allocated to the next cell, ensuring that the first candidate for each subject is allocated in order. <syntaxhighlight lang="prolog">allocate_candidate( [Subject|Subjects], Next, Candidate, Subjects1, Next1 ) :- Subject = [Candidate|Candidates], Candidate =< Next, Next1 is max(Candidate+1,Next), residual_candidates( Candidates, Subjects, Subjects1 ). allocate_candidate( [Subject|Subjects], Next, Candidate, [Subject|Subjects1], Next1 ) :- Subject = [Candidate0|_Candidates], Candidate0 < Next, allocate_candidate( Subjects, Next, Candidate, Subjects1, Next1 ). residual_candidates( [], Subjects, Subjects ). residual_candidates( Candidates, Subjects, [Candidates|Subjects] ) :- Candidates = [_|_].</syntaxhighlight> ====matrix( ?Matrix )==== holds when <var>Matrix</var> is a list of 'cells' ordered by their (x,y) coordinates. Each 'cell' is described by 5 binary digits, which indicate the subject assigned to it, and the set of successors of the cell that are adjacent to it. <syntaxhighlight lang="prolog">matrix( Matrix ) :- layout( Layout ), matrix1( Layout, _Index, Matrix ). matrix1( [], _Index, [] ). matrix1( [(Row, Column)|Layout], Index, [Cell|Matrix] ) :- location_cell( Row, Column, Index, Cell ), findall( (Row1, Column1), ( successor( (Row, Column), (Row1, Column1) ), adjacent(Row, Row1), adjacent(Column, Column1) ), AdjacentSuccessorLocations ), location_cells( AdjacentSuccessorLocations, Index, AdjacentSuccessors ), adjacent_successors( Cell, AdjacentSuccessors ), matrix1( Layout, Index, Matrix ).</syntaxhighlight> ====cell( ?Subject, ?Cell )==== holds when <var>Cell</var> is the cell representation for <var>Subject</var>. <syntaxhighlight lang="prolog">cell( 1, cell(1,0,0,0,0,_) ). cell( 2, cell(0,1,0,0,0,_) ). cell( 3, cell(0,0,1,0,0,_) ). cell( 4, cell(0,0,0,1,0,_) ). cell( 5, cell(0,0,0,0,1,_) ).</syntaxhighlight> ====block( ?Subject, ?Block )==== holds when <var>Block</var> is a cell representation that is incompatible with <var>Subject</var>. <syntaxhighlight lang="prolog">block( 1, cell(0,_,_,_,_,_) ). block( 2, cell(_,0,_,_,_,_) ). block( 3, cell(_,_,0,_,_,_) ). block( 4, cell(_,_,_,0,_,_) ). block( 5, cell(_,_,_,_,0,_) ).</syntaxhighlight> ====adjacent_successors( ?Cell, ?AdjacentSuccesors )==== holds when <var>AdjacentSuccesors</var> is the set of successors of <var>Cell</var> that are adjacent to it. <syntaxhighlight lang="prolog">adjacent_successors( cell(_,_,_,_,_,AdjacentSuccesors), AdjacentSuccesors ).</syntaxhighlight> ====blocked( +Blocked, ?Subject )==== holds when all the cells in <var>Blocked</var> are incompatible with <var>Subject</var>. <syntaxhighlight lang="prolog">blocked( [], _Subject ). blocked( [Cell|Blocked], Subject ) :- block( Subject, Cell ), blocked( Blocked, Subject ).</syntaxhighlight> ====adjacent( +Coordinate0, ?Coordinate1 )==== holds when <var>Coordinate0</var> and <var>Coordinate1</var> are the same or differ by 1. <syntaxhighlight lang="prolog">adjacent( N, N ). adjacent( N0, N1 ) :- N1 is N0 + 1. adjacent( N0, N1 ) :- N1 is N0 - 1.</syntaxhighlight> ====location_cells( ?Locations, ?Index, ?Cells )==== holds when <var>Index</var> is a 6 &times; 6 array, <var>Locations</var> is a list of (Row,Column) pairs and <var>Cells</var> is the list of matching cells dereferenced from <var>Index</var>. <syntaxhighlight lang="prolog">location_cells( [], _Index, [] ). location_cells( [(Row, Column)|Locs], Index, [Cell|Cells] ) :- location_cell( Row, Column, Index, Cell ), location_cells( Locs, Index, Cells ).</syntaxhighlight> ====location_cell( ?Row, ?Column, ?Index, ?Cell )==== holds when <var>Index</var> is a 6 &times; 6 array with <var>Cell</var> at location (<var>Row</var>,<var>Column</var>). <syntaxhighlight lang="prolog">location_cell( Row, Column, Index, Cell ) :- select_nth( Row, Index, IndexRow ), select_nth( Column, IndexRow, Cell ).</syntaxhighlight> ====select_nth( ?N, ?Array, ?Element )==== holds when <var>Element</var> is the <var>N</var>th element of <var>Array</var>. <syntaxhighlight lang="prolog">select_nth( 1, array_6(A,_B,_C,_D,_E,_F), A ). select_nth( 2, array_6(_A,B,_C,_D,_E,_F), B ). select_nth( 3, array_6(_A,_B,C,_D,_E,_F), C ). select_nth( 4, array_6(_A,_B,_C,D,_E,_F), D ). select_nth( 5, array_6(_A,_B,_C,_D,E,_F), E ). select_nth( 6, array_6(_A,_B,_C,_D,_E,F), F ).</syntaxhighlight> ====successor( ?Coordinates0, ?Coordinates1 )==== holds when <var>Coordinates0</var> and <var>Coordinates1</var> are valid cell positions and <var>Coordinates0</var> &lt;<var>Coordinates1</var>. <syntaxhighlight lang="prolog">successor( Coordinates0, Coordinates1 ) :- layout( Layout ), append( _Prefix, [Coordinates0|Successors], Layout ), member( Coordinates1, Successors ).</syntaxhighlight> ====candidates( ?Subjects, ?Candidates )==== holds when there are 4 <var>Candidates</var> for each <var>Subject</var>. <syntaxhighlight lang="prolog">candidates( [], [] ). candidates( [Subj|Subjects], [[Subj,Subj,Subj,Subj]|Candidates] ) :- candidates( Subjects, Candidates ).</syntaxhighlight> ====layout( ?Layout )==== holds when <var>Layout</var> is the sequence of all (x,y) co-ordinates of valid 'cells'. <syntaxhighlight lang="prolog">layout( [ (1,2), (2,2),(2,3),(2,4),(2,5),(2,6), (3,2),(3,3),(3,4),(3,5), (4,2),(4,3),(4,4),(4,5), (5,1),(5,2),(5,3),(5,4),(5,5), (6,5) ] ).</syntaxhighlight> Load a small library of [https://binding-time.co.uk/misc.html puzzle utilities]. <syntaxhighlight lang="prolog">:- ensure_loaded( misc ).</syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/download/nut1.txt here]. === Result === This program reports '''29870''' solutions. ebf490805e56354b57a60512a0fdd70d8de7fbfb 45 40 2013-10-15T23:00:30Z John 2 /* candidates( ?Subjects, ?Candidates ) */ wikitext text/x-wiki ==Constrained Permutations in Prolog== __NOTOC__ Problem posted to [http://groups.google.com/group/comp.lang.prolog/msg/a984ea325e0a4180 comp.lang.prolog] by Daniel Dudley ===Problem Statement=== <blockquote>A university was to hold an examination in 5 subjects: Norwegian, German, English, French and Spanish. In each of these languages there were 4 candidates. The examination room was therefore divided into 20 cells, as shown in the figure below (view this in a fixed font): <pre> X X X X X X X X X X X X X X X X X X X X</pre> The university's administration wanted to secure themselves against cheating. Candidates in the same language were to be completely isolated from each other - so much so that their cells were not to coincide even at the corners. A young lecturer was given the job of finding a solution to the problem, which he did, and justly received a pat on the back from the dean. Now it just so happens that the dean is an ardent prolog programmer in his spare time (how else could he make dean?) and, realizing that there could be several solutions to the problem, used his skills to find all solutions. Can you do the same? </blockquote> ===Note=== &quot;Several solutions&quot; doesn't really cover it! Assuming that by 'a solution' we mean finding a mapping between candidates and cells, then, having found one such solution, we can find 955,514,879 other members of its solution &quot;family&quot; quite easily, through: * ''candidate permutation'': There are (4!)⁵ permutations of the candidates within the cells allocated to their subjects; * ''subject permutation'': we can multiply the 'candidate permutations' by the 5! permutations of the subjects allocated to particular sets of cells. This means that the total number of solutions is 955514880 &times; D where D is the number of solution families i.e. solutions that cannot be derived from each other by candidate or subject permutation. Finding [[#Result|D]] is the more interesting problem solved by this program. ====nut1( ?Solutions )==== <var>Solutions</var> is the number of distinct solutions to the subject/cell allocation problem for any five different subjects. <syntaxhighlight lang="prolog">nut1( Solutions ) :- Norwegian = 1, German = 2, English = 3, French = 4, Spanish = 5, candidates( [Norwegian,German,English,French,Spanish], Candidates ), matrix( Cells ), findall( x, % We don't care about the actual solution allocate(Cells, Candidates), Allocations ), length( Allocations, Solutions ).</syntaxhighlight> ====allocate( +Cells, +Candidates )==== holds when each cell in <var>Cells</var> holds a candidate from <var>Candidates</var>. <syntaxhighlight lang="prolog">allocate( Cells, Candidates ) :- allocation( Cells, 1, Candidates ).</syntaxhighlight> ====allocation( +Cells, +NextSubject, +Subjects )==== holds when <var>Cells</var> is a representation of a distinct solution to the subject/cell allocation problem. <var>NextSubject</var> is the highest subject that can be allocated next, while <var>Subjects</var> is the list of subjects needing allocation to <var>Cells</var>. Each subject is represented by a list, in which each occurrence of the subject number represents a candidate. We guarantee distinct solutions by ensuring that the allocation is made on the following basis: * For each subject: the location of the N+1th candidate must be a successor of the location of the Nth candidate - to eliminate 'candidate permutations'. * The location of the first candidate of the N+1th subject must be a successor of the location of the first candidate of the Nth subject - to eliminate 'subject permutations'. Operationally, at each step we select a candidate for a cell and constrain all the cell's adjacent successors to have different subject(s) from it. <syntaxhighlight lang="prolog">allocation( [], _Next, [] ). allocation( [Cell|Cells], Next, Subjects ) :- allocate_candidate( Subjects, Next, Candidate, Subjects1, Next1 ), cell( Candidate, Cell ), adjacent_successors( Cell, AdjacentSuccessors ), blocked( AdjacentSuccessors, Candidate ), allocation( Cells, Next1, Subjects1 ).</syntaxhighlight> ====allocate_candidate( +Subjects, +Next, ?Candidate, ?Subjects1, ?Next1 )==== holds when <var>Candidate</var> is taken from <var>Subjects</var> leaving <var>Subjects1</var>. <var>Candidate</var> is represented by a subject number <code>=<</code> <var>Next</var>. <var>Next1</var> is the highest subject that can be allocated to the next cell, ensuring that the first candidate for each subject is allocated in order. <syntaxhighlight lang="prolog">allocate_candidate( [Subject|Subjects], Next, Candidate, Subjects1, Next1 ) :- Subject = [Candidate|Candidates], Candidate =< Next, Next1 is max(Candidate+1,Next), residual_candidates( Candidates, Subjects, Subjects1 ). allocate_candidate( [Subject|Subjects], Next, Candidate, [Subject|Subjects1], Next1 ) :- Subject = [Candidate0|_Candidates], Candidate0 < Next, allocate_candidate( Subjects, Next, Candidate, Subjects1, Next1 ). residual_candidates( [], Subjects, Subjects ). residual_candidates( Candidates, Subjects, [Candidates|Subjects] ) :- Candidates = [_|_].</syntaxhighlight> ====matrix( ?Matrix )==== holds when <var>Matrix</var> is a list of 'cells' ordered by their (x,y) coordinates. Each 'cell' is described by 5 binary digits, which indicate the subject assigned to it, and the set of successors of the cell that are adjacent to it. <syntaxhighlight lang="prolog">matrix( Matrix ) :- layout( Layout ), matrix1( Layout, _Index, Matrix ). matrix1( [], _Index, [] ). matrix1( [(Row, Column)|Layout], Index, [Cell|Matrix] ) :- location_cell( Row, Column, Index, Cell ), findall( (Row1, Column1), ( successor( (Row, Column), (Row1, Column1) ), adjacent(Row, Row1), adjacent(Column, Column1) ), AdjacentSuccessorLocations ), location_cells( AdjacentSuccessorLocations, Index, AdjacentSuccessors ), adjacent_successors( Cell, AdjacentSuccessors ), matrix1( Layout, Index, Matrix ).</syntaxhighlight> ====cell( ?Subject, ?Cell )==== holds when <var>Cell</var> is the cell representation for <var>Subject</var>. <syntaxhighlight lang="prolog">cell( 1, cell(1,0,0,0,0,_) ). cell( 2, cell(0,1,0,0,0,_) ). cell( 3, cell(0,0,1,0,0,_) ). cell( 4, cell(0,0,0,1,0,_) ). cell( 5, cell(0,0,0,0,1,_) ).</syntaxhighlight> ====block( ?Subject, ?Block )==== holds when <var>Block</var> is a cell representation that is incompatible with <var>Subject</var>. <syntaxhighlight lang="prolog">block( 1, cell(0,_,_,_,_,_) ). block( 2, cell(_,0,_,_,_,_) ). block( 3, cell(_,_,0,_,_,_) ). block( 4, cell(_,_,_,0,_,_) ). block( 5, cell(_,_,_,_,0,_) ).</syntaxhighlight> ====adjacent_successors( ?Cell, ?AdjacentSuccesors )==== holds when <var>AdjacentSuccesors</var> is the set of successors of <var>Cell</var> that are adjacent to it. <syntaxhighlight lang="prolog">adjacent_successors( cell(_,_,_,_,_,AdjacentSuccesors), AdjacentSuccesors ).</syntaxhighlight> ====blocked( +Blocked, ?Subject )==== holds when all the cells in <var>Blocked</var> are incompatible with <var>Subject</var>. <syntaxhighlight lang="prolog">blocked( [], _Subject ). blocked( [Cell|Blocked], Subject ) :- block( Subject, Cell ), blocked( Blocked, Subject ).</syntaxhighlight> ====adjacent( +Coordinate0, ?Coordinate1 )==== holds when <var>Coordinate0</var> and <var>Coordinate1</var> are the same or differ by 1. <syntaxhighlight lang="prolog">adjacent( N, N ). adjacent( N0, N1 ) :- N1 is N0 + 1. adjacent( N0, N1 ) :- N1 is N0 - 1.</syntaxhighlight> ====location_cells( ?Locations, ?Index, ?Cells )==== holds when <var>Index</var> is a 6 &times; 6 array, <var>Locations</var> is a list of (Row,Column) pairs and <var>Cells</var> is the list of matching cells dereferenced from <var>Index</var>. <syntaxhighlight lang="prolog">location_cells( [], _Index, [] ). location_cells( [(Row, Column)|Locs], Index, [Cell|Cells] ) :- location_cell( Row, Column, Index, Cell ), location_cells( Locs, Index, Cells ).</syntaxhighlight> ====location_cell( ?Row, ?Column, ?Index, ?Cell )==== holds when <var>Index</var> is a 6 &times; 6 array with <var>Cell</var> at location (<var>Row</var>,<var>Column</var>). <syntaxhighlight lang="prolog">location_cell( Row, Column, Index, Cell ) :- select_nth( Row, Index, IndexRow ), select_nth( Column, IndexRow, Cell ).</syntaxhighlight> ====select_nth( ?N, ?Array, ?Element )==== holds when <var>Element</var> is the <var>N</var>th element of <var>Array</var>. <syntaxhighlight lang="prolog">select_nth( 1, array_6(A,_B,_C,_D,_E,_F), A ). select_nth( 2, array_6(_A,B,_C,_D,_E,_F), B ). select_nth( 3, array_6(_A,_B,C,_D,_E,_F), C ). select_nth( 4, array_6(_A,_B,_C,D,_E,_F), D ). select_nth( 5, array_6(_A,_B,_C,_D,E,_F), E ). select_nth( 6, array_6(_A,_B,_C,_D,_E,F), F ).</syntaxhighlight> ====successor( ?Coordinates0, ?Coordinates1 )==== holds when <var>Coordinates0</var> and <var>Coordinates1</var> are valid cell positions and <var>Coordinates0</var> &lt;<var>Coordinates1</var>. <syntaxhighlight lang="prolog">successor( Coordinates0, Coordinates1 ) :- layout( Layout ), append( _Prefix, [Coordinates0|Successors], Layout ), member( Coordinates1, Successors ).</syntaxhighlight> ====candidates( ?Subjects, ?Candidates )==== holds when there are 4 <var>Candidates</var> for each subject in <var>Subjects</var>. <syntaxhighlight lang="prolog">candidates( [], [] ). candidates( [Subj|Subjects], [[Subj,Subj,Subj,Subj]|Candidates] ) :- candidates( Subjects, Candidates ).</syntaxhighlight> ====layout( ?Layout )==== holds when <var>Layout</var> is the sequence of all (x,y) co-ordinates of valid 'cells'. <syntaxhighlight lang="prolog">layout( [ (1,2), (2,2),(2,3),(2,4),(2,5),(2,6), (3,2),(3,3),(3,4),(3,5), (4,2),(4,3),(4,4),(4,5), (5,1),(5,2),(5,3),(5,4),(5,5), (6,5) ] ).</syntaxhighlight> Load a small library of [https://binding-time.co.uk/misc.html puzzle utilities]. <syntaxhighlight lang="prolog">:- ensure_loaded( misc ).</syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/download/nut1.txt here]. === Result === This program reports '''29870''' solutions. 618a899725a9df209fe83260e885f4bc41b20317 49 45 2013-10-19T19:48:33Z John 2 /* nut1( ?Solutions ) */ wikitext text/x-wiki ==Constrained Permutations in Prolog== __NOTOC__ Problem posted to [http://groups.google.com/group/comp.lang.prolog/msg/a984ea325e0a4180 comp.lang.prolog] by Daniel Dudley ===Problem Statement=== <blockquote>A university was to hold an examination in 5 subjects: Norwegian, German, English, French and Spanish. In each of these languages there were 4 candidates. The examination room was therefore divided into 20 cells, as shown in the figure below (view this in a fixed font): <pre> X X X X X X X X X X X X X X X X X X X X</pre> The university's administration wanted to secure themselves against cheating. Candidates in the same language were to be completely isolated from each other - so much so that their cells were not to coincide even at the corners. A young lecturer was given the job of finding a solution to the problem, which he did, and justly received a pat on the back from the dean. Now it just so happens that the dean is an ardent prolog programmer in his spare time (how else could he make dean?) and, realizing that there could be several solutions to the problem, used his skills to find all solutions. Can you do the same? </blockquote> ===Note=== &quot;Several solutions&quot; doesn't really cover it! Assuming that by 'a solution' we mean finding a mapping between candidates and cells, then, having found one such solution, we can find 955,514,879 other members of its solution &quot;family&quot; quite easily, through: * ''candidate permutation'': There are (4!)⁵ permutations of the candidates within the cells allocated to their subjects; * ''subject permutation'': we can multiply the 'candidate permutations' by the 5! permutations of the subjects allocated to particular sets of cells. This means that the total number of solutions is 955514880 &times; D where D is the number of solution families i.e. solutions that cannot be derived from each other by candidate or subject permutation. Finding [[#Result|D]] is the more interesting problem solved by this program. ====nut1( ?Solutions )==== <var>Solutions</var> is the number of distinct solutions to the subject/cell allocation problem for any five different subjects. <syntaxhighlight lang="prolog">nut1( Solutions ) :- Norwegian = 1, German = 2, English = 3, French = 4, Spanish = 5, candidates( [Norwegian,German,English,French,Spanish], Candidates ), matrix( Cells ), count_solutions( allocate(Cells,Candidates), Solutions ).</syntaxhighlight> ====allocate( +Cells, +Candidates )==== holds when each cell in <var>Cells</var> holds a candidate from <var>Candidates</var>. <syntaxhighlight lang="prolog">allocate( Cells, Candidates ) :- allocation( Cells, 1, Candidates ).</syntaxhighlight> ====allocation( +Cells, +NextSubject, +Subjects )==== holds when <var>Cells</var> is a representation of a distinct solution to the subject/cell allocation problem. <var>NextSubject</var> is the highest subject that can be allocated next, while <var>Subjects</var> is the list of subjects needing allocation to <var>Cells</var>. Each subject is represented by a list, in which each occurrence of the subject number represents a candidate. We guarantee distinct solutions by ensuring that the allocation is made on the following basis: * For each subject: the location of the N+1th candidate must be a successor of the location of the Nth candidate - to eliminate 'candidate permutations'. * The location of the first candidate of the N+1th subject must be a successor of the location of the first candidate of the Nth subject - to eliminate 'subject permutations'. Operationally, at each step we select a candidate for a cell and constrain all the cell's adjacent successors to have different subject(s) from it. <syntaxhighlight lang="prolog">allocation( [], _Next, [] ). allocation( [Cell|Cells], Next, Subjects ) :- allocate_candidate( Subjects, Next, Candidate, Subjects1, Next1 ), cell( Candidate, Cell ), adjacent_successors( Cell, AdjacentSuccessors ), blocked( AdjacentSuccessors, Candidate ), allocation( Cells, Next1, Subjects1 ).</syntaxhighlight> ====allocate_candidate( +Subjects, +Next, ?Candidate, ?Subjects1, ?Next1 )==== holds when <var>Candidate</var> is taken from <var>Subjects</var> leaving <var>Subjects1</var>. <var>Candidate</var> is represented by a subject number <code>=<</code> <var>Next</var>. <var>Next1</var> is the highest subject that can be allocated to the next cell, ensuring that the first candidate for each subject is allocated in order. <syntaxhighlight lang="prolog">allocate_candidate( [Subject|Subjects], Next, Candidate, Subjects1, Next1 ) :- Subject = [Candidate|Candidates], Candidate =< Next, Next1 is max(Candidate+1,Next), residual_candidates( Candidates, Subjects, Subjects1 ). allocate_candidate( [Subject|Subjects], Next, Candidate, [Subject|Subjects1], Next1 ) :- Subject = [Candidate0|_Candidates], Candidate0 < Next, allocate_candidate( Subjects, Next, Candidate, Subjects1, Next1 ). residual_candidates( [], Subjects, Subjects ). residual_candidates( Candidates, Subjects, [Candidates|Subjects] ) :- Candidates = [_|_].</syntaxhighlight> ====matrix( ?Matrix )==== holds when <var>Matrix</var> is a list of 'cells' ordered by their (x,y) coordinates. Each 'cell' is described by 5 binary digits, which indicate the subject assigned to it, and the set of successors of the cell that are adjacent to it. <syntaxhighlight lang="prolog">matrix( Matrix ) :- layout( Layout ), matrix1( Layout, _Index, Matrix ). matrix1( [], _Index, [] ). matrix1( [(Row, Column)|Layout], Index, [Cell|Matrix] ) :- location_cell( Row, Column, Index, Cell ), findall( (Row1, Column1), ( successor( (Row, Column), (Row1, Column1) ), adjacent(Row, Row1), adjacent(Column, Column1) ), AdjacentSuccessorLocations ), location_cells( AdjacentSuccessorLocations, Index, AdjacentSuccessors ), adjacent_successors( Cell, AdjacentSuccessors ), matrix1( Layout, Index, Matrix ).</syntaxhighlight> ====cell( ?Subject, ?Cell )==== holds when <var>Cell</var> is the cell representation for <var>Subject</var>. <syntaxhighlight lang="prolog">cell( 1, cell(1,0,0,0,0,_) ). cell( 2, cell(0,1,0,0,0,_) ). cell( 3, cell(0,0,1,0,0,_) ). cell( 4, cell(0,0,0,1,0,_) ). cell( 5, cell(0,0,0,0,1,_) ).</syntaxhighlight> ====block( ?Subject, ?Block )==== holds when <var>Block</var> is a cell representation that is incompatible with <var>Subject</var>. <syntaxhighlight lang="prolog">block( 1, cell(0,_,_,_,_,_) ). block( 2, cell(_,0,_,_,_,_) ). block( 3, cell(_,_,0,_,_,_) ). block( 4, cell(_,_,_,0,_,_) ). block( 5, cell(_,_,_,_,0,_) ).</syntaxhighlight> ====adjacent_successors( ?Cell, ?AdjacentSuccesors )==== holds when <var>AdjacentSuccesors</var> is the set of successors of <var>Cell</var> that are adjacent to it. <syntaxhighlight lang="prolog">adjacent_successors( cell(_,_,_,_,_,AdjacentSuccesors), AdjacentSuccesors ).</syntaxhighlight> ====blocked( +Blocked, ?Subject )==== holds when all the cells in <var>Blocked</var> are incompatible with <var>Subject</var>. <syntaxhighlight lang="prolog">blocked( [], _Subject ). blocked( [Cell|Blocked], Subject ) :- block( Subject, Cell ), blocked( Blocked, Subject ).</syntaxhighlight> ====adjacent( +Coordinate0, ?Coordinate1 )==== holds when <var>Coordinate0</var> and <var>Coordinate1</var> are the same or differ by 1. <syntaxhighlight lang="prolog">adjacent( N, N ). adjacent( N0, N1 ) :- N1 is N0 + 1. adjacent( N0, N1 ) :- N1 is N0 - 1.</syntaxhighlight> ====location_cells( ?Locations, ?Index, ?Cells )==== holds when <var>Index</var> is a 6 &times; 6 array, <var>Locations</var> is a list of (Row,Column) pairs and <var>Cells</var> is the list of matching cells dereferenced from <var>Index</var>. <syntaxhighlight lang="prolog">location_cells( [], _Index, [] ). location_cells( [(Row, Column)|Locs], Index, [Cell|Cells] ) :- location_cell( Row, Column, Index, Cell ), location_cells( Locs, Index, Cells ).</syntaxhighlight> ====location_cell( ?Row, ?Column, ?Index, ?Cell )==== holds when <var>Index</var> is a 6 &times; 6 array with <var>Cell</var> at location (<var>Row</var>,<var>Column</var>). <syntaxhighlight lang="prolog">location_cell( Row, Column, Index, Cell ) :- select_nth( Row, Index, IndexRow ), select_nth( Column, IndexRow, Cell ).</syntaxhighlight> ====select_nth( ?N, ?Array, ?Element )==== holds when <var>Element</var> is the <var>N</var>th element of <var>Array</var>. <syntaxhighlight lang="prolog">select_nth( 1, array_6(A,_B,_C,_D,_E,_F), A ). select_nth( 2, array_6(_A,B,_C,_D,_E,_F), B ). select_nth( 3, array_6(_A,_B,C,_D,_E,_F), C ). select_nth( 4, array_6(_A,_B,_C,D,_E,_F), D ). select_nth( 5, array_6(_A,_B,_C,_D,E,_F), E ). select_nth( 6, array_6(_A,_B,_C,_D,_E,F), F ).</syntaxhighlight> ====successor( ?Coordinates0, ?Coordinates1 )==== holds when <var>Coordinates0</var> and <var>Coordinates1</var> are valid cell positions and <var>Coordinates0</var> &lt;<var>Coordinates1</var>. <syntaxhighlight lang="prolog">successor( Coordinates0, Coordinates1 ) :- layout( Layout ), append( _Prefix, [Coordinates0|Successors], Layout ), member( Coordinates1, Successors ).</syntaxhighlight> ====candidates( ?Subjects, ?Candidates )==== holds when there are 4 <var>Candidates</var> for each subject in <var>Subjects</var>. <syntaxhighlight lang="prolog">candidates( [], [] ). candidates( [Subj|Subjects], [[Subj,Subj,Subj,Subj]|Candidates] ) :- candidates( Subjects, Candidates ).</syntaxhighlight> ====layout( ?Layout )==== holds when <var>Layout</var> is the sequence of all (x,y) co-ordinates of valid 'cells'. <syntaxhighlight lang="prolog">layout( [ (1,2), (2,2),(2,3),(2,4),(2,5),(2,6), (3,2),(3,3),(3,4),(3,5), (4,2),(4,3),(4,4),(4,5), (5,1),(5,2),(5,3),(5,4),(5,5), (6,5) ] ).</syntaxhighlight> Load a small library of [https://binding-time.co.uk/misc.html puzzle utilities]. <syntaxhighlight lang="prolog">:- ensure_loaded( misc ).</syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/download/nut1.txt here]. === Result === This program reports '''29870''' solutions. f3dc527542893af228554fe94133f57eb2d5c714 50 49 2013-10-19T19:49:27Z John 2 /* layout( ?Layout ) */ wikitext text/x-wiki ==Constrained Permutations in Prolog== __NOTOC__ Problem posted to [http://groups.google.com/group/comp.lang.prolog/msg/a984ea325e0a4180 comp.lang.prolog] by Daniel Dudley ===Problem Statement=== <blockquote>A university was to hold an examination in 5 subjects: Norwegian, German, English, French and Spanish. In each of these languages there were 4 candidates. The examination room was therefore divided into 20 cells, as shown in the figure below (view this in a fixed font): <pre> X X X X X X X X X X X X X X X X X X X X</pre> The university's administration wanted to secure themselves against cheating. Candidates in the same language were to be completely isolated from each other - so much so that their cells were not to coincide even at the corners. A young lecturer was given the job of finding a solution to the problem, which he did, and justly received a pat on the back from the dean. Now it just so happens that the dean is an ardent prolog programmer in his spare time (how else could he make dean?) and, realizing that there could be several solutions to the problem, used his skills to find all solutions. Can you do the same? </blockquote> ===Note=== &quot;Several solutions&quot; doesn't really cover it! Assuming that by 'a solution' we mean finding a mapping between candidates and cells, then, having found one such solution, we can find 955,514,879 other members of its solution &quot;family&quot; quite easily, through: * ''candidate permutation'': There are (4!)⁵ permutations of the candidates within the cells allocated to their subjects; * ''subject permutation'': we can multiply the 'candidate permutations' by the 5! permutations of the subjects allocated to particular sets of cells. This means that the total number of solutions is 955514880 &times; D where D is the number of solution families i.e. solutions that cannot be derived from each other by candidate or subject permutation. Finding [[#Result|D]] is the more interesting problem solved by this program. ====nut1( ?Solutions )==== <var>Solutions</var> is the number of distinct solutions to the subject/cell allocation problem for any five different subjects. <syntaxhighlight lang="prolog">nut1( Solutions ) :- Norwegian = 1, German = 2, English = 3, French = 4, Spanish = 5, candidates( [Norwegian,German,English,French,Spanish], Candidates ), matrix( Cells ), count_solutions( allocate(Cells,Candidates), Solutions ).</syntaxhighlight> ====allocate( +Cells, +Candidates )==== holds when each cell in <var>Cells</var> holds a candidate from <var>Candidates</var>. <syntaxhighlight lang="prolog">allocate( Cells, Candidates ) :- allocation( Cells, 1, Candidates ).</syntaxhighlight> ====allocation( +Cells, +NextSubject, +Subjects )==== holds when <var>Cells</var> is a representation of a distinct solution to the subject/cell allocation problem. <var>NextSubject</var> is the highest subject that can be allocated next, while <var>Subjects</var> is the list of subjects needing allocation to <var>Cells</var>. Each subject is represented by a list, in which each occurrence of the subject number represents a candidate. We guarantee distinct solutions by ensuring that the allocation is made on the following basis: * For each subject: the location of the N+1th candidate must be a successor of the location of the Nth candidate - to eliminate 'candidate permutations'. * The location of the first candidate of the N+1th subject must be a successor of the location of the first candidate of the Nth subject - to eliminate 'subject permutations'. Operationally, at each step we select a candidate for a cell and constrain all the cell's adjacent successors to have different subject(s) from it. <syntaxhighlight lang="prolog">allocation( [], _Next, [] ). allocation( [Cell|Cells], Next, Subjects ) :- allocate_candidate( Subjects, Next, Candidate, Subjects1, Next1 ), cell( Candidate, Cell ), adjacent_successors( Cell, AdjacentSuccessors ), blocked( AdjacentSuccessors, Candidate ), allocation( Cells, Next1, Subjects1 ).</syntaxhighlight> ====allocate_candidate( +Subjects, +Next, ?Candidate, ?Subjects1, ?Next1 )==== holds when <var>Candidate</var> is taken from <var>Subjects</var> leaving <var>Subjects1</var>. <var>Candidate</var> is represented by a subject number <code>=<</code> <var>Next</var>. <var>Next1</var> is the highest subject that can be allocated to the next cell, ensuring that the first candidate for each subject is allocated in order. <syntaxhighlight lang="prolog">allocate_candidate( [Subject|Subjects], Next, Candidate, Subjects1, Next1 ) :- Subject = [Candidate|Candidates], Candidate =< Next, Next1 is max(Candidate+1,Next), residual_candidates( Candidates, Subjects, Subjects1 ). allocate_candidate( [Subject|Subjects], Next, Candidate, [Subject|Subjects1], Next1 ) :- Subject = [Candidate0|_Candidates], Candidate0 < Next, allocate_candidate( Subjects, Next, Candidate, Subjects1, Next1 ). residual_candidates( [], Subjects, Subjects ). residual_candidates( Candidates, Subjects, [Candidates|Subjects] ) :- Candidates = [_|_].</syntaxhighlight> ====matrix( ?Matrix )==== holds when <var>Matrix</var> is a list of 'cells' ordered by their (x,y) coordinates. Each 'cell' is described by 5 binary digits, which indicate the subject assigned to it, and the set of successors of the cell that are adjacent to it. <syntaxhighlight lang="prolog">matrix( Matrix ) :- layout( Layout ), matrix1( Layout, _Index, Matrix ). matrix1( [], _Index, [] ). matrix1( [(Row, Column)|Layout], Index, [Cell|Matrix] ) :- location_cell( Row, Column, Index, Cell ), findall( (Row1, Column1), ( successor( (Row, Column), (Row1, Column1) ), adjacent(Row, Row1), adjacent(Column, Column1) ), AdjacentSuccessorLocations ), location_cells( AdjacentSuccessorLocations, Index, AdjacentSuccessors ), adjacent_successors( Cell, AdjacentSuccessors ), matrix1( Layout, Index, Matrix ).</syntaxhighlight> ====cell( ?Subject, ?Cell )==== holds when <var>Cell</var> is the cell representation for <var>Subject</var>. <syntaxhighlight lang="prolog">cell( 1, cell(1,0,0,0,0,_) ). cell( 2, cell(0,1,0,0,0,_) ). cell( 3, cell(0,0,1,0,0,_) ). cell( 4, cell(0,0,0,1,0,_) ). cell( 5, cell(0,0,0,0,1,_) ).</syntaxhighlight> ====block( ?Subject, ?Block )==== holds when <var>Block</var> is a cell representation that is incompatible with <var>Subject</var>. <syntaxhighlight lang="prolog">block( 1, cell(0,_,_,_,_,_) ). block( 2, cell(_,0,_,_,_,_) ). block( 3, cell(_,_,0,_,_,_) ). block( 4, cell(_,_,_,0,_,_) ). block( 5, cell(_,_,_,_,0,_) ).</syntaxhighlight> ====adjacent_successors( ?Cell, ?AdjacentSuccesors )==== holds when <var>AdjacentSuccesors</var> is the set of successors of <var>Cell</var> that are adjacent to it. <syntaxhighlight lang="prolog">adjacent_successors( cell(_,_,_,_,_,AdjacentSuccesors), AdjacentSuccesors ).</syntaxhighlight> ====blocked( +Blocked, ?Subject )==== holds when all the cells in <var>Blocked</var> are incompatible with <var>Subject</var>. <syntaxhighlight lang="prolog">blocked( [], _Subject ). blocked( [Cell|Blocked], Subject ) :- block( Subject, Cell ), blocked( Blocked, Subject ).</syntaxhighlight> ====adjacent( +Coordinate0, ?Coordinate1 )==== holds when <var>Coordinate0</var> and <var>Coordinate1</var> are the same or differ by 1. <syntaxhighlight lang="prolog">adjacent( N, N ). adjacent( N0, N1 ) :- N1 is N0 + 1. adjacent( N0, N1 ) :- N1 is N0 - 1.</syntaxhighlight> ====location_cells( ?Locations, ?Index, ?Cells )==== holds when <var>Index</var> is a 6 &times; 6 array, <var>Locations</var> is a list of (Row,Column) pairs and <var>Cells</var> is the list of matching cells dereferenced from <var>Index</var>. <syntaxhighlight lang="prolog">location_cells( [], _Index, [] ). location_cells( [(Row, Column)|Locs], Index, [Cell|Cells] ) :- location_cell( Row, Column, Index, Cell ), location_cells( Locs, Index, Cells ).</syntaxhighlight> ====location_cell( ?Row, ?Column, ?Index, ?Cell )==== holds when <var>Index</var> is a 6 &times; 6 array with <var>Cell</var> at location (<var>Row</var>,<var>Column</var>). <syntaxhighlight lang="prolog">location_cell( Row, Column, Index, Cell ) :- select_nth( Row, Index, IndexRow ), select_nth( Column, IndexRow, Cell ).</syntaxhighlight> ====select_nth( ?N, ?Array, ?Element )==== holds when <var>Element</var> is the <var>N</var>th element of <var>Array</var>. <syntaxhighlight lang="prolog">select_nth( 1, array_6(A,_B,_C,_D,_E,_F), A ). select_nth( 2, array_6(_A,B,_C,_D,_E,_F), B ). select_nth( 3, array_6(_A,_B,C,_D,_E,_F), C ). select_nth( 4, array_6(_A,_B,_C,D,_E,_F), D ). select_nth( 5, array_6(_A,_B,_C,_D,E,_F), E ). select_nth( 6, array_6(_A,_B,_C,_D,_E,F), F ).</syntaxhighlight> ====successor( ?Coordinates0, ?Coordinates1 )==== holds when <var>Coordinates0</var> and <var>Coordinates1</var> are valid cell positions and <var>Coordinates0</var> &lt;<var>Coordinates1</var>. <syntaxhighlight lang="prolog">successor( Coordinates0, Coordinates1 ) :- layout( Layout ), append( _Prefix, [Coordinates0|Successors], Layout ), member( Coordinates1, Successors ).</syntaxhighlight> ====candidates( ?Subjects, ?Candidates )==== holds when there are 4 <var>Candidates</var> for each subject in <var>Subjects</var>. <syntaxhighlight lang="prolog">candidates( [], [] ). candidates( [Subj|Subjects], [[Subj,Subj,Subj,Subj]|Candidates] ) :- candidates( Subjects, Candidates ).</syntaxhighlight> ====layout( ?Layout )==== holds when <var>Layout</var> is the sequence of all (x,y) co-ordinates of valid 'cells'. <syntaxhighlight lang="prolog">layout( [ (1,2), (2,2),(2,3),(2,4),(2,5),(2,6), (3,2),(3,3),(3,4),(3,5), (4,2),(4,3),(4,4),(4,5), (5,1),(5,2),(5,3),(5,4),(5,5), (6,5) ] ).</syntaxhighlight> Load a small library of [[Puzzle Utilities]]. <syntaxhighlight lang="prolog">:- ensure_loaded( misc ).</syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/download/nut1.txt here]. === Result === This program reports '''29870''' solutions. 4133c82d48e04c287151c80eadd4aca04bc3e53c 0 11 37 2013-10-13T22:07:44Z John 2 John moved page [[Cheating Linguists?]] to [[Cheating Linguists]]: Ambiguous URL treatment. wikitext text/x-wiki #REDIRECT [[Cheating Linguists]] 25dfaf6fff091ca9b4e5bdb055d1543569770b5c 0 12 47 2013-10-19T19:44:44Z John 2 Created page with "The following predicates are used in the puzzle solutions. ==Higher-order Predicates== ====unique_solution( +Goal )==== holds when <var>Goal</var> has one ground solution. ..." wikitext text/x-wiki The following predicates are used in the puzzle solutions. ==Higher-order Predicates== ====unique_solution( +Goal )==== holds when <var>Goal</var> has one ground solution. Operationally, <var>Goal</var> may produce several solutions, ("don't care" non-deterministically), but they must all be identical (<code>==</code>). <syntaxhighlight lang="prolog">unique_solution( Goal ) :- findall( Goal, Goal, [Solution|Solutions] ), same_solution( Solutions, Solution ), Solution = Goal. same_solution( [], _Solution ). same_solution( [Solution0|Solutions], Solution ) :- Solution0 == Solution, same_solution( Solutions, Solution ).</syntaxhighlight> ====forall( +Enumerator, +Test )==== is true if <var>Enumerator</var> and <var>Test</var> are goals and <var>Test</var> holds everywhere that <var>Enumerator</var> does. NB: forall/2 does not instantiate arguments further. <syntaxhighlight lang="prolog">forall( Enumerator, Test ) :- \+ (call(Enumerator), \+ call(Test)).</syntaxhighlight> ====count_solutions( +Goal, ?Count )==== is true if <var>Count</var> is the number of solutions for <var>Goal</var>. The solutions might not be distinct. <code>count_solutions/2</code> enumerates the possible solutions to <var>Goal</var> but does not instantiate <var>Goal</var>'s arguments further. <syntaxhighlight lang="prolog"> count_solutions( Goal, Count ) :- findall( x, Goal, Xs ), length( Xs, Count ). </syntaxhighlight> ==Lists== ====member( ?Element, ?List )==== holds when <var>Element</var> is a member of <var>List</var>. <syntaxhighlight lang="prolog">member( H, [H|_] ). member( H, [_|T] ) :- member( H, T ).</syntaxhighlight> ====select( ?Element, ?List0, ?List1 )==== is true if <var>List1</var> is equal to <var>List0</var> with <var>Element</var> removed. <syntaxhighlight lang="prolog">select( H, [H|T], T ). select( Element, [H|T0], [H|T1] ) :- select( Element, T0, T1 ).</syntaxhighlight> ====memberchk( +Element, +List )==== succeeds (once) if <var>Element</var> is a member of <var>List</var>. <syntaxhighlight lang="prolog">memberchk( Element, List ) :- member( Element, List ), !.</syntaxhighlight> ==Arithmetic== ====between( +Lower, +Upper, ?Index )==== is true if <var>Lower</var> =< <var>Index</var> =< <var>Upper</var>. Two valid cases are possible: * <var>Index</var> is already instantiated to an integer, so the checks on order are applied (test). * <var>Index</var> is a logical variable: a series of alternative solutions may be generated as the monotonic sequence of values between <var>Lower</var> and <var>Upper</var> (non-deterministic generator). <syntaxhighlight lang="prolog">between( Lower, Upper, Index ) :- integer( Lower ), integer( Upper ), Lower =< Upper, ( integer( Index ) -> % Case 1: "test" Index >= Lower, Index =< Upper ; var( Index ) -> % Case 2: "generate". generate_between( Lower, Upper, Index ) ). generate_between( Lower, Upper, Index ) :- ( Lower =:= Upper -> Index = Lower ; Index = Lower ; Next is Lower + 1, Next =< Upper, generate_between( Next, Upper, Index ) ).</syntaxhighlight> ====sum( +List, ?Sum )==== holds when the <var>List</var> of numbers sum to <var>Sum</var>. <syntaxhighlight lang="prolog">sum( [H|T], Sum ) :- sum1( T, H, Sum ). sum1( [], Sum, Sum ). sum1( [H|T], Sum0, Sum ):- Sum1 is Sum0 + H, sum1( T, Sum1, Sum ).</syntaxhighlight> ==Character Input/Output== ====put_chars( +Chars )==== if <var>Chars</var> is a (possibly empty) list of character codes and the corresponding characters are written to the current output stream. <syntaxhighlight lang="prolog">put_chars( [] ). put_chars( [Char|Chars] ) :- put( Char ), put_chars( Chars ).</syntaxhighlight> ====get_chars( ?Chars )==== if <var>Chars</var> is a (possibly empty) list of character codes read from the current input stream. <syntaxhighlight lang="prolog">get_chars( Input ) :- get0( Char ), ( Char > -1 -> Input = [Char|Chars], get_chars( Chars ) ; otherwise -> Input = [] ).</syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/download/misc.txt here]. e2b1a8ba9a59cce596067c85bdb098811a802e91 0 2 52 51 2013-11-01T21:11:51Z John 2 /* imbalance_inferences( +Lighter, +Heavier, +Table, ?Coins ) */ wikitext text/x-wiki __NOTOC__ ==Problem Definition== We are given 12 apparently identical coins - one of which is counterfeit. We know that the counterfeit has a different weight from the others, but we don't know if it's heavier or lighter. ===Task:=== Devise a procedure to identify any counterfeit coin using a balance to take up to three comparative weighings. ==Strategy== The information from three suitable weighings will make all but one of the 'coins', which are untested initially, 'known true'. There are three alternative deductions that make a coin 'known true': * if it is 'not heavy' and 'not light' - having been on both the comparatively lighter and heavier sides of imbalances; * if it was excluded from an imbalance; * if it was included in a balanced weighing. After three weighings there must be exactly one coin, the counterfeit, which is not 'true'. If the counterfeit is not true and 'not heavy' we deduce that it must be light. If it is not true and 'not light', it must be heavy. We use a 'generate-and-test' method as follows: * Create the set of all possible 'counterfeits': 12 coins &times; 2 weights ; * Devise a procedure that can identify the first counterfeit coin; * Show that the same procedure works for every other counterfeit. ==Entry Point== ====go==== is the entry point. It solves the puzzle, then uses a DCG to pretty-print the resulting procedure. <syntaxhighlight lang="prolog"> go :- coins_puzzle( Procedure ), phrase( general_explanation( Procedure ), Chars ), put_chars( Chars ). </syntaxhighlight> ====coins_puzzle( ?Procedure )==== generates the set of all possible 'counterfeits' and finds (or proves) that <var>Procedure</var> can identify them all. <syntaxhighlight lang="prolog"> coins_puzzle( Procedure ) :- coins( Coins ), counterfeit( Counterfeit, Coin, Weight ), findall( Counterfeit, (member(Coin,Coins), counterfeit_weight(Weight)), Counterfeits ), coins_puzzle_solution( Counterfeits, Procedure ). coins_puzzle_solution( [], _Procedure ). coins_puzzle_solution( [Counterfeit|Counterfeits], Procedure ) :- solve_coins( Counterfeit, Procedure ), coins_puzzle_solution( Counterfeits, Procedure ). </syntaxhighlight> A procedure is either 'done', identifying a particular coin and whether it is 'heavy' or 'light'; or it is a 'step'. A step defines the coins to be placed on the <var>Left</var> and <var>Right</var> pans, with the residue remaining on the <var>Table</var>, and three <var>Branches</var>, one of which will be chosen depending on the outcome of the weighing. <syntaxhighlight lang="prolog"> step( step(Left,Right,Table,Branches), Left, Right, Table, Branches). </syntaxhighlight> The <var>Branches</var> are three procedures equating to: * > (left pan heavier), * < (right pan heavier) and * <nowiki>= (pans balance).</nowiki> <syntaxhighlight lang="prolog"> branch( >, branches(_Equal, GT, _LT), GT ). branch( <, branches(_Equal, _GT, LT), LT ). branch( =, branches(Equal, _GT, _LT), Equal ). </syntaxhighlight> The counterfeit is defined by its number and whether it is heavy or light. <syntaxhighlight lang="prolog"> counterfeit( counterfeit(Coin, HeavyOrLight), Coin, HeavyOrLight ). coins( [1,2,3,4,5,6,7,8,9,10,11,12] ). counterfeit_weight( heavy ). counterfeit_weight( light ). </syntaxhighlight> A 'coin collection' comprises four 'parts' (subsets): the <code>known_true</code>, <code>not_heavy</code>, <code>not_light</code> and <code>untested</code> sets of coins. <syntaxhighlight lang="prolog"> part( known_true, collection(Coins,_,_,_), Coins ). part( not_heavy, collection(_,Coins,_,_), Coins ). part( not_light, collection(_,_,Coins,_), Coins ). part( untested, collection(_,_,_,Coins), Coins ). </syntaxhighlight> ==Solution== ====solve_coins( +Counterfeit, ?Procedure )==== holds when <var>Procedure</var> can correctly identify the <var>Counterfeit</var> coin. Beginning with a 'start' collection, in which all the coins are untested, the <var>Procedure</var> comprises three 'steps'. For each step a 'weighing' is made and a 'branch' is made in the <var>Procedure</var>, depending on the result of the weighing. After three steps, the <var>Procedure</var> must have reached the 'end' condition. Finally, an assertion (redundant test) ensures that the <var>Procedure</var> has found the correct end condition. <syntaxhighlight lang="prolog"> solve_coins( Counterfeit, Procedure ) :- start( Coins0 ), assay( Counterfeit, Coins0, Procedure, Branch1, Coins1 ), assay( Counterfeit, Coins1, Branch1, Branch2, Coins2 ), assay( Counterfeit, Coins2, Branch2, done(Coin, HeavyOrLight), Coins3 ), end( Coins3, Coin, HeavyOrLight ), counterfeit( Counterfeit, Coin, HeavyOrLight ). start( Coins ) :- coins( Untested ), part( untested, Coins, Untested ), part( not_heavy, Coins, [] ), part( not_light, Coins, [] ), part( known_true, Coins, [] ). end( Coins, Coin, HeavyOrLight ) :- part( untested, Coins, [] ), part( not_heavy, Coins, Light ), part( not_light, Coins, Heavy ), end_result( Heavy, Light, Coin, HeavyOrLight ). end_result( [Coin], [], Coin, heavy ). end_result( [], [Coin], Coin, light ). </syntaxhighlight> === Simulating the weighing process === ====assay( +Counterfeit, +Coins0, ?Step, ?Branch, ?Coins1 )==== holds when the appropriate <var>Branch</var> from <var>Step</var> is chosen by comparing the weights of two coin collections taken from the full set of coins: <var>Coins0</var>. <var>Coins1</var> is the full set of coins, updated with the inferences drawn from the weighing. <var>Counterfeit</var> is used to determine the result of the weighing. This predicate applies the critical insight into the solution of this puzzle: we have 24 (12 &times; 2) possible inputs to the procedure, with only 27 (3 &times; 3 &times; 3) possible outcomes from the weighings. Therefore, it is clear that each weighing must have a very high 'information content'. Choosing which weighing to make by estimating the available information content makes the problem tractable. <syntaxhighlight lang="prolog"> assay( Counterfeit, Coins0, Step, Branch, Coins ) :- WeighingDatum = weighing_data(InfoContent, Left, Right, Table), step( Step, Left, Right, Table, Branches ), findall( WeighingDatum, valid_partition( Coins0, InfoContent, Left, Right, Table ), WeighingData ), sort( WeighingData, OrderedWeighingData ), member( WeighingDatum, OrderedWeighingData ), balance( Left, Right, Counterfeit, Result ), draw_inferences( Result, Left, Right, Table, Coins ), branch( Result, Branches, Branch ). </syntaxhighlight> ====balance( +Left, +Right, +Counterfeit, ?Result )==== holds when <var>Result</var> simulates the outcome of testing the coin collections <var>Left</var> and <var>Right</var> with a balance, where either may contain the <var>Counterfeit</var> coin. <syntaxhighlight lang="prolog"> balance( Left, Right, Counterfeit, Result ):- counterfeit( Counterfeit, Coin, Weight ), ( contains_coin( Left, Coin ) -> balance_result( Weight, normal, Result ) ; contains_coin( Right, Coin ) -> balance_result( normal, Weight, Result ) ; otherwise -> Result = '=' ). balance_result( light, normal, < ). balance_result( heavy, normal, > ). balance_result( normal, heavy, < ). balance_result( normal, light, > ). </syntaxhighlight> ===Choosing which coins to weigh=== ====valid_partition( +Coins, ?Content, ?Left, ?Right, ?Table )==== holds when <var>Coins</var> can be partitioned into three collections: <var>Left</var> side, <var>Right</var> side and <var>Table</var>; with the 'information content' of the partition given by <var>Content</var>. The definition of a 'valid partition' ensures that: * <var>Left</var> and <var>Right</var> must have the same number of coins (at least one); * <var>Left</var> cannot contain any known 'true' coins, because adding true coins to both sides creates redundant comparisons. A 'checksum' is used to ensure that only one member of each pair of symmetrical solutions can be generated. <syntaxhighlight lang="prolog"> valid_partition( Coins, Content, Left, Right, Table ):- part( known_true, Left, [] ), selection( Coins, Left, Coins1, Count, LeftChecksum, LeftInfo ), Count >= 1, selection( Coins1, Right, Table, Count, RightChecksum, RightInfo ), LeftChecksum =< RightChecksum, % Checksum to prevent symmetrical solutions table_information( Table, TableInfo ), sum( [LeftInfo,RightInfo,TableInfo], Content ). </syntaxhighlight> ====selection( +Coins, ?Sample, ?Residue, ?Count, ?Checksum, ?Content )==== holds when <var>Coins</var> is partitioned into two collections: <var>Sample</var> and <var>Residue</var>. <var>Count</var> is the number of coins in <var>Sample</var>. <var>Checksum</var> is a fingerprint for the mixture of coins in <var>Sample</var>, which has 'information content' <var>Content</var>. <syntaxhighlight lang="prolog"> selection( Coins, Sample, Residue, Count, Checksum, Content ) :- select_coins( not_heavy, Coins, Sample, Residue, Count1 ), select_coins( not_light, Coins, Sample, Residue, Count2 ), select_coins( untested, Coins, Sample, Residue, Count3 ), select_coins( known_true, Coins, Sample, Residue, Count4 ), Count is Count1+Count2+Count3+Count4, Count =< 6, Checksum is Count1+(7*Count2)+(43*Count3)+(259*Count4), information_content( [Count1,Count2,Count3,Count4], Content ). </syntaxhighlight> ====table_information( +Coins, ?Content )==== holds when <var>Coins</var> has 'information content' <var>Content</var>. <syntaxhighlight lang="prolog"> table_information( Coins, Content ) :- count_coins( not_heavy, Coins, Count1 ), count_coins( not_light, Coins, Count2 ), count_coins( untested, Coins, Count3 ), count_coins( known_true, Coins, Count4 ), information_content( [Count1,Count2,Count3,Count4], Content ). count_coins( Part, Coins, Count ) :- part( Part, Coins, Selection ), length( Selection, Count ). </syntaxhighlight> === Updating what is known about the coins === ====draw_inferences( +Result, +Left, +Right, +Table, ?Coins )==== holds when <var>Result</var> is one of: * > (imbalance - left pan heavier), * < (imbalance - right pan heavier) or * <nowiki>=</nowiki> (pans balanced) from taking a weighing with the coin collections: <var>Left</var>, <var>Right</var> and <var>Table</var>. <var>Coins</var> is derived from this information using the following rules: * If the pans are unbalanced then only the previously untested or not_heavy coins on the lighter side of the balance are now not_heavy. Similarly, only the previously untested or not_light coins on the heavier side of the balance are now not_light. All the coins on the table are now known_true. * If the pans balance then all the coins weighed are known_true, with the coins on the <var>Table</var> left in their prior states. <syntaxhighlight lang="prolog"> draw_inferences( <, Left, Right, Table, Coins ) :- imbalance_inferences( Left, Right, Table, Coins ). draw_inferences( >, Left, Right, Table, Coins ) :- imbalance_inferences( Right, Left, Table, Coins ). draw_inferences( =, Left, Right, Table, Coins ) :- becomes( [all(Left),known_true(Table),all(Right)], known_true( Coins ) ), becomes( untested(Table), untested(Coins) ), becomes( not_heavy(Table), not_heavy(Coins) ), becomes( not_light(Table), not_light(Coins) ). </syntaxhighlight> ====imbalance_inferences( +Lighter, +Heavier, +Table, ?Coins )==== holds when: * All untested or not_heavy coins in <var>Lighter</var> are not_heavy in <var>Coins</var>; * All untested or not_light coins in <var>Heavier</var> are not_light in <var>Coins</var>; * All coins in <var>Table</var> are known_true in <var>Coins</var>; There are no untested coins in <var>Coins</var>. <syntaxhighlight lang="prolog"> imbalance_inferences( Lighter, Heavier, Table, Coins ) :- becomes( [untested(Lighter),not_heavy(Lighter)], not_heavy(Coins) ), becomes( [untested(Heavier),not_light(Heavier)], not_light(Coins) ), becomes( [ known_true(Lighter), not_light(Lighter), known_true(Heavier), not_heavy(Heavier), all(Table) ], known_true(Coins) ), part( untested, Coins, [] ). </syntaxhighlight> ====inference( +CollectionA, ?CollectionB )==== holds when (part) <var>CollectionB</var> comprises the same coins as (part) <var>CollectionA</var>. <syntaxhighlight lang="prolog"> inference( CollectionA, CollectionB ) :- unfolded( CollectionA, Coins ), unfolded( CollectionB, Coins ). </syntaxhighlight> ====unfolded( +Collection, ?Coins )==== holds when (part) <var>Collection</var> comprises <var>Coins</var>. <syntaxhighlight lang="prolog"> unfolded( not_light(Collection), Coins ) :- part( not_light, Collection, Coins ). unfolded( not_heavy(Collection), Coins ) :- part( not_heavy, Collection, Coins ). unfolded( known_true(Collection), Coins ) :- part( known_true, Collection, Coins ). unfolded( untested(Collection), Coins ) :- part( untested, Collection, Coins ). unfolded( all(Collection), Coins ) :- collection_to_set( Collection, Coins ). unfolded( [Item|Items], Coins ) :- unfolded( Item, Value ), unfolded1( Items, Value, Coins ). unfolded1( [], Coins, Coins ). unfolded1( [Item|Items], Value, Coins ) :- unfolded( Item, Value0 ), ord_union( Value0, Value, Value1 ), unfolded1( Items, Value1, Coins ). </syntaxhighlight> ==Definite Clause Grammar== The following DCG represents the method for finding the counterfeit coin as a 'structured' procedure. <syntaxhighlight lang="prolog"> general_explanation( Procedure ) --> "Number the coins 1..12", newline, explanation( Procedure, 0 ). explanation( done(Coin, Weight), N ) --> tab( N ), "Conclude that the counterfeit coin is number ", literal( Coin ), ", which is ", literal( Weight ), newline. explanation( Step, N ) --> {step( Step, Left, Right, Table, Branches )}, tab( N ), "BEGIN", newline, tab( N ), "Put ", literal( Left ), " on the left-hand pan", newline, tab( N ), "Put ", literal( Right ), " on the right-hand pan", newline, tab( N ), "Leaving ", literal( Table ), " on the table", newline, branches_explained( Branches, N ), tab( N ), "END", newline. branches_explained( Branches, N ) --> next_step_explained( <, Branches, N ), next_step_explained( >, Branches, N ), next_step_explained( =, Branches, N ). next_step_explained( Result, Branch, N ) --> {branch( Result, Branch, Step )}, ( {var(Step)} -> "" | {nonvar(Step)} -> tab( N ), "If the ", literal( Result ), " then:", newline, explanation( Step, s(N) ) ). literal( 0 ) --> "0". literal( 1 ) --> "1". literal( 2 ) --> "2". literal( 3 ) --> "3". literal( 4 ) --> "4". literal( 5 ) --> "5". literal( 6 ) --> "6". literal( 7 ) --> "7". literal( 8 ) --> "8". literal( 9 ) --> "9". literal( 10 ) --> "10". literal( 11 ) --> "11". literal( 12 ) --> "12". literal( true ) --> "true". literal( heavy ) --> "heavy". literal( light ) --> "light". literal( = ) --> "pans balance". literal( < ) --> "right-hand pan is heavier". literal( > ) --> "left-hand pan is heavier". literal( Collection ) --> {collection_to_set( Collection , [H|T] )}, literal_set( T, H ). literal_set( [], Number ) --> "the coin numbered ", literal( Number ). literal_set( [H|T], Number ) --> "the coins numbered ", literal( Number ), literal_set1( T, H ). literal_set1( [], Number ) --> " and ", literal( Number ). literal_set1( [H|T], Number ) --> ", ", literal( Number ), literal_set1( T, H ). tab( 0 ) --> "". tab( s(N) ) --> " ", tab( N ). newline --> " ". </syntaxhighlight> ===Utility Predicates=== ====contains_coin( ?Collection, ?Coin )==== holds when <var>Coin</var> is a member of <var>Collection</var>. <syntaxhighlight lang="prolog"> contains_coin( Collection, Coin ) :- part( _Part, Collection, Coins ), member( Coin, Coins ). </syntaxhighlight> ====collection_to_set( +Collection, ?Set )==== holds when <var>Set</var> is the distributed union of the <code>known_true</code>, <code>not_heavy</code>, <code>not_light</code> and <code>untested</code> ordsets comprising <var>Collection</var>. <syntaxhighlight lang="prolog"> collection_to_set( Collection, Set ) :- part( known_true, Collection, KnownTrue ), part( not_heavy, Collection, NotHeavy ), part( not_light, Collection, NotLight ), part( untested, Collection, Untested ), ord_union( [KnownTrue,NotHeavy,NotLight,Untested], Set ). </syntaxhighlight> ==== information_content( +Counts, ?Content ) ==== holds when <var>Content</var> is the cumulative negative entropy of <var>Counts</var>. A reduction in entropy equates to a gain in information. <syntaxhighlight lang="prolog"> information_content( Counts, Content ) :- information_content1( Counts, 0, Content ). information_content1( [], Content, Content ). information_content1( [Count|Counts], Content0, Content ):- coins_entropy( Count, Entropy ), Content1 is Content0-Entropy, information_content1( Counts, Content1, Content ). </syntaxhighlight> ==== coins_entropy( ?N, ?Entropy ) ==== holds when <var>Entropy</var> estimates the entropy of a sample of <var>N</var> coins. <var>Entropy</var> = P log₂(1/P), where P = <var>N</var>/12. <syntaxhighlight lang="prolog"> coins_entropy( 0, 0.0 ). coins_entropy( 1, 0.2987 ). coins_entropy( 2, 0.4308 ). coins_entropy( 3, 0.5 ). coins_entropy( 4, 0.5283 ). coins_entropy( 5, 0.5263 ). coins_entropy( 6, 0.5 ). coins_entropy( 7, 0.4536 ). coins_entropy( 8, 0.39 ). coins_entropy( 9, 0.3113 ). coins_entropy( 10, 0.2192 ). coins_entropy( 11, 0.1151 ). coins_entropy( 12, 0.0 ). </syntaxhighlight> ====select_coins( +Part, +Coins, ?Sample, ?Residue, ?N )==== holds when <var>N</var> coins from <var>Part</var> of <var>Coins</var> form <var>Part</var> of <var>Sample</var>, with the remainder forming <var>Part</var> of <var>Residue</var>. <syntaxhighlight lang="prolog"> select_coins( Part, Coins, Sample, Residue, Count ) :- part( Part, Coins, Input ), part( Part, Sample, Selection ), part( Part, Residue, Remainder ), select_n( Count, Input, Selection, Remainder ). select_n( 0, In, [], In ). select_n( 1, [A|Suffix], [A], Suffix ). select_n( 2, [A,B|Suffix], [A,B], Suffix ). select_n( 3, [A,B,C|Suffix], [A,B,C], Suffix ). select_n( 4, [A,B,C,D|Suffix], [A,B,C,D], Suffix ). select_n( 5, [A,B,C,D,E|Suffix], [A,B,C,D,E], Suffix ). select_n( 6, [A,B,C,D,E,F|Suffix], [A,B,C,D,E,F], Suffix ). </syntaxhighlight> Load a small library of [[Puzzle Utilities]]. <syntaxhighlight lang="prolog"> :- ensure_loaded( misc ). </syntaxhighlight> Use the ordsets library. <syntaxhighlight lang="prolog"> :- use_module( library(ordsets), [ord_union/2,ord_union/3] ). </syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/download/counterfeit.txt here]. ==Output== <div class="result"> Number the coins 1..12 BEGIN Put the coins numbered 1, 2, 3 and 4 on the left-hand pan Put the coins numbered 5, 6, 7 and 8 on the right-hand pan Leaving the coins numbered 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 1, 2, 5 and 6 on the left-hand pan Put the coins numbered 3, 7, 9 and 10 on the right-hand pan Leaving the coins numbered 4, 8, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 1 and 7 on the left-hand pan Put the coins numbered 3 and 4 on the right-hand pan Leaving the coins numbered 2, 5, 6, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 1, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 7, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 2, which is light END If the left-hand pan is heavier then: BEGIN Put the coins numbered 3 and 5 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 4, 6, 7, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 3, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 5, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 6, which is heavy END If the pans balance then: BEGIN Put the coins numbered 4 and 8 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 3, 5, 6, 7, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 4, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 8, which is heavy END END If the left-hand pan is heavier then: BEGIN Put the coins numbered 1, 2, 5 and 6 on the left-hand pan Put the coins numbered 3, 7, 9 and 10 on the right-hand pan Leaving the coins numbered 4, 8, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 3 and 5 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 4, 6, 7, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 5, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 3, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 6, which is light END If the left-hand pan is heavier then: BEGIN Put the coins numbered 1 and 7 on the left-hand pan Put the coins numbered 3 and 4 on the right-hand pan Leaving the coins numbered 2, 5, 6, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 7, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 1, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 2, which is heavy END If the pans balance then: BEGIN Put the coins numbered 4 and 8 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 3, 5, 6, 7, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 8, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 4, which is heavy END END If the pans balance then: BEGIN Put the coins numbered 9, 10 and 11 on the left-hand pan Put the coins numbered 1, 2 and 3 on the right-hand pan Leaving the coins numbered 4, 5, 6, 7, 8 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coin numbered 9 on the left-hand pan Put the coin numbered 10 on the right-hand pan Leaving the coins numbered 1, 2, 3, 4, 5, 6, 7, 8, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 9, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 10, which is light If the pans balance then: Conclude that the counterfeit coin is number 11, which is light END If the left-hand pan is heavier then: BEGIN Put the coin numbered 9 on the left-hand pan Put the coin numbered 10 on the right-hand pan Leaving the coins numbered 1, 2, 3, 4, 5, 6, 7, 8, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 10, which is heavy If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 9, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 11, which is heavy END If the pans balance then: BEGIN Put the coin numbered 12 on the left-hand pan Put the coin numbered 1 on the right-hand pan Leaving the coins numbered 2, 3, 4, 5, 6, 7, 8, 9, 10 and 11 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 12, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 12, which is heavy END END END </div> ---- 5d69effc6ff08d8dfe0924cf7b7680c6ea1c2bd9 53 52 2013-11-01T21:14:40Z John 2 /* inference( +CollectionA, ?CollectionB ) */ wikitext text/x-wiki __NOTOC__ ==Problem Definition== We are given 12 apparently identical coins - one of which is counterfeit. We know that the counterfeit has a different weight from the others, but we don't know if it's heavier or lighter. ===Task:=== Devise a procedure to identify any counterfeit coin using a balance to take up to three comparative weighings. ==Strategy== The information from three suitable weighings will make all but one of the 'coins', which are untested initially, 'known true'. There are three alternative deductions that make a coin 'known true': * if it is 'not heavy' and 'not light' - having been on both the comparatively lighter and heavier sides of imbalances; * if it was excluded from an imbalance; * if it was included in a balanced weighing. After three weighings there must be exactly one coin, the counterfeit, which is not 'true'. If the counterfeit is not true and 'not heavy' we deduce that it must be light. If it is not true and 'not light', it must be heavy. We use a 'generate-and-test' method as follows: * Create the set of all possible 'counterfeits': 12 coins &times; 2 weights ; * Devise a procedure that can identify the first counterfeit coin; * Show that the same procedure works for every other counterfeit. ==Entry Point== ====go==== is the entry point. It solves the puzzle, then uses a DCG to pretty-print the resulting procedure. <syntaxhighlight lang="prolog"> go :- coins_puzzle( Procedure ), phrase( general_explanation( Procedure ), Chars ), put_chars( Chars ). </syntaxhighlight> ====coins_puzzle( ?Procedure )==== generates the set of all possible 'counterfeits' and finds (or proves) that <var>Procedure</var> can identify them all. <syntaxhighlight lang="prolog"> coins_puzzle( Procedure ) :- coins( Coins ), counterfeit( Counterfeit, Coin, Weight ), findall( Counterfeit, (member(Coin,Coins), counterfeit_weight(Weight)), Counterfeits ), coins_puzzle_solution( Counterfeits, Procedure ). coins_puzzle_solution( [], _Procedure ). coins_puzzle_solution( [Counterfeit|Counterfeits], Procedure ) :- solve_coins( Counterfeit, Procedure ), coins_puzzle_solution( Counterfeits, Procedure ). </syntaxhighlight> A procedure is either 'done', identifying a particular coin and whether it is 'heavy' or 'light'; or it is a 'step'. A step defines the coins to be placed on the <var>Left</var> and <var>Right</var> pans, with the residue remaining on the <var>Table</var>, and three <var>Branches</var>, one of which will be chosen depending on the outcome of the weighing. <syntaxhighlight lang="prolog"> step( step(Left,Right,Table,Branches), Left, Right, Table, Branches). </syntaxhighlight> The <var>Branches</var> are three procedures equating to: * > (left pan heavier), * < (right pan heavier) and * <nowiki>= (pans balance).</nowiki> <syntaxhighlight lang="prolog"> branch( >, branches(_Equal, GT, _LT), GT ). branch( <, branches(_Equal, _GT, LT), LT ). branch( =, branches(Equal, _GT, _LT), Equal ). </syntaxhighlight> The counterfeit is defined by its number and whether it is heavy or light. <syntaxhighlight lang="prolog"> counterfeit( counterfeit(Coin, HeavyOrLight), Coin, HeavyOrLight ). coins( [1,2,3,4,5,6,7,8,9,10,11,12] ). counterfeit_weight( heavy ). counterfeit_weight( light ). </syntaxhighlight> A 'coin collection' comprises four 'parts' (subsets): the <code>known_true</code>, <code>not_heavy</code>, <code>not_light</code> and <code>untested</code> sets of coins. <syntaxhighlight lang="prolog"> part( known_true, collection(Coins,_,_,_), Coins ). part( not_heavy, collection(_,Coins,_,_), Coins ). part( not_light, collection(_,_,Coins,_), Coins ). part( untested, collection(_,_,_,Coins), Coins ). </syntaxhighlight> ==Solution== ====solve_coins( +Counterfeit, ?Procedure )==== holds when <var>Procedure</var> can correctly identify the <var>Counterfeit</var> coin. Beginning with a 'start' collection, in which all the coins are untested, the <var>Procedure</var> comprises three 'steps'. For each step a 'weighing' is made and a 'branch' is made in the <var>Procedure</var>, depending on the result of the weighing. After three steps, the <var>Procedure</var> must have reached the 'end' condition. Finally, an assertion (redundant test) ensures that the <var>Procedure</var> has found the correct end condition. <syntaxhighlight lang="prolog"> solve_coins( Counterfeit, Procedure ) :- start( Coins0 ), assay( Counterfeit, Coins0, Procedure, Branch1, Coins1 ), assay( Counterfeit, Coins1, Branch1, Branch2, Coins2 ), assay( Counterfeit, Coins2, Branch2, done(Coin, HeavyOrLight), Coins3 ), end( Coins3, Coin, HeavyOrLight ), counterfeit( Counterfeit, Coin, HeavyOrLight ). start( Coins ) :- coins( Untested ), part( untested, Coins, Untested ), part( not_heavy, Coins, [] ), part( not_light, Coins, [] ), part( known_true, Coins, [] ). end( Coins, Coin, HeavyOrLight ) :- part( untested, Coins, [] ), part( not_heavy, Coins, Light ), part( not_light, Coins, Heavy ), end_result( Heavy, Light, Coin, HeavyOrLight ). end_result( [Coin], [], Coin, heavy ). end_result( [], [Coin], Coin, light ). </syntaxhighlight> === Simulating the weighing process === ====assay( +Counterfeit, +Coins0, ?Step, ?Branch, ?Coins1 )==== holds when the appropriate <var>Branch</var> from <var>Step</var> is chosen by comparing the weights of two coin collections taken from the full set of coins: <var>Coins0</var>. <var>Coins1</var> is the full set of coins, updated with the inferences drawn from the weighing. <var>Counterfeit</var> is used to determine the result of the weighing. This predicate applies the critical insight into the solution of this puzzle: we have 24 (12 &times; 2) possible inputs to the procedure, with only 27 (3 &times; 3 &times; 3) possible outcomes from the weighings. Therefore, it is clear that each weighing must have a very high 'information content'. Choosing which weighing to make by estimating the available information content makes the problem tractable. <syntaxhighlight lang="prolog"> assay( Counterfeit, Coins0, Step, Branch, Coins ) :- WeighingDatum = weighing_data(InfoContent, Left, Right, Table), step( Step, Left, Right, Table, Branches ), findall( WeighingDatum, valid_partition( Coins0, InfoContent, Left, Right, Table ), WeighingData ), sort( WeighingData, OrderedWeighingData ), member( WeighingDatum, OrderedWeighingData ), balance( Left, Right, Counterfeit, Result ), draw_inferences( Result, Left, Right, Table, Coins ), branch( Result, Branches, Branch ). </syntaxhighlight> ====balance( +Left, +Right, +Counterfeit, ?Result )==== holds when <var>Result</var> simulates the outcome of testing the coin collections <var>Left</var> and <var>Right</var> with a balance, where either may contain the <var>Counterfeit</var> coin. <syntaxhighlight lang="prolog"> balance( Left, Right, Counterfeit, Result ):- counterfeit( Counterfeit, Coin, Weight ), ( contains_coin( Left, Coin ) -> balance_result( Weight, normal, Result ) ; contains_coin( Right, Coin ) -> balance_result( normal, Weight, Result ) ; otherwise -> Result = '=' ). balance_result( light, normal, < ). balance_result( heavy, normal, > ). balance_result( normal, heavy, < ). balance_result( normal, light, > ). </syntaxhighlight> ===Choosing which coins to weigh=== ====valid_partition( +Coins, ?Content, ?Left, ?Right, ?Table )==== holds when <var>Coins</var> can be partitioned into three collections: <var>Left</var> side, <var>Right</var> side and <var>Table</var>; with the 'information content' of the partition given by <var>Content</var>. The definition of a 'valid partition' ensures that: * <var>Left</var> and <var>Right</var> must have the same number of coins (at least one); * <var>Left</var> cannot contain any known 'true' coins, because adding true coins to both sides creates redundant comparisons. A 'checksum' is used to ensure that only one member of each pair of symmetrical solutions can be generated. <syntaxhighlight lang="prolog"> valid_partition( Coins, Content, Left, Right, Table ):- part( known_true, Left, [] ), selection( Coins, Left, Coins1, Count, LeftChecksum, LeftInfo ), Count >= 1, selection( Coins1, Right, Table, Count, RightChecksum, RightInfo ), LeftChecksum =< RightChecksum, % Checksum to prevent symmetrical solutions table_information( Table, TableInfo ), sum( [LeftInfo,RightInfo,TableInfo], Content ). </syntaxhighlight> ====selection( +Coins, ?Sample, ?Residue, ?Count, ?Checksum, ?Content )==== holds when <var>Coins</var> is partitioned into two collections: <var>Sample</var> and <var>Residue</var>. <var>Count</var> is the number of coins in <var>Sample</var>. <var>Checksum</var> is a fingerprint for the mixture of coins in <var>Sample</var>, which has 'information content' <var>Content</var>. <syntaxhighlight lang="prolog"> selection( Coins, Sample, Residue, Count, Checksum, Content ) :- select_coins( not_heavy, Coins, Sample, Residue, Count1 ), select_coins( not_light, Coins, Sample, Residue, Count2 ), select_coins( untested, Coins, Sample, Residue, Count3 ), select_coins( known_true, Coins, Sample, Residue, Count4 ), Count is Count1+Count2+Count3+Count4, Count =< 6, Checksum is Count1+(7*Count2)+(43*Count3)+(259*Count4), information_content( [Count1,Count2,Count3,Count4], Content ). </syntaxhighlight> ====table_information( +Coins, ?Content )==== holds when <var>Coins</var> has 'information content' <var>Content</var>. <syntaxhighlight lang="prolog"> table_information( Coins, Content ) :- count_coins( not_heavy, Coins, Count1 ), count_coins( not_light, Coins, Count2 ), count_coins( untested, Coins, Count3 ), count_coins( known_true, Coins, Count4 ), information_content( [Count1,Count2,Count3,Count4], Content ). count_coins( Part, Coins, Count ) :- part( Part, Coins, Selection ), length( Selection, Count ). </syntaxhighlight> === Updating what is known about the coins === ====draw_inferences( +Result, +Left, +Right, +Table, ?Coins )==== holds when <var>Result</var> is one of: * > (imbalance - left pan heavier), * < (imbalance - right pan heavier) or * <nowiki>=</nowiki> (pans balanced) from taking a weighing with the coin collections: <var>Left</var>, <var>Right</var> and <var>Table</var>. <var>Coins</var> is derived from this information using the following rules: * If the pans are unbalanced then only the previously untested or not_heavy coins on the lighter side of the balance are now not_heavy. Similarly, only the previously untested or not_light coins on the heavier side of the balance are now not_light. All the coins on the table are now known_true. * If the pans balance then all the coins weighed are known_true, with the coins on the <var>Table</var> left in their prior states. <syntaxhighlight lang="prolog"> draw_inferences( <, Left, Right, Table, Coins ) :- imbalance_inferences( Left, Right, Table, Coins ). draw_inferences( >, Left, Right, Table, Coins ) :- imbalance_inferences( Right, Left, Table, Coins ). draw_inferences( =, Left, Right, Table, Coins ) :- becomes( [all(Left),known_true(Table),all(Right)], known_true( Coins ) ), becomes( untested(Table), untested(Coins) ), becomes( not_heavy(Table), not_heavy(Coins) ), becomes( not_light(Table), not_light(Coins) ). </syntaxhighlight> ====imbalance_inferences( +Lighter, +Heavier, +Table, ?Coins )==== holds when: * All untested or not_heavy coins in <var>Lighter</var> are not_heavy in <var>Coins</var>; * All untested or not_light coins in <var>Heavier</var> are not_light in <var>Coins</var>; * All coins in <var>Table</var> are known_true in <var>Coins</var>; There are no untested coins in <var>Coins</var>. <syntaxhighlight lang="prolog"> imbalance_inferences( Lighter, Heavier, Table, Coins ) :- becomes( [untested(Lighter),not_heavy(Lighter)], not_heavy(Coins) ), becomes( [untested(Heavier),not_light(Heavier)], not_light(Coins) ), becomes( [ known_true(Lighter), not_light(Lighter), known_true(Heavier), not_heavy(Heavier), all(Table) ], known_true(Coins) ), part( untested, Coins, [] ). </syntaxhighlight> ====becomes( +CollectionA, ?CollectionB )==== <var>CollectionA</var> becomes (part) <var>CollectionB</var> when <var>CollectionB</var> comprises the same coins as <var>CollectionA</var>. <syntaxhighlight lang="prolog"> becomes( CollectionA, CollectionB ) :- unfolded( CollectionA, Coins ), unfolded( CollectionB, Coins ). </syntaxhighlight> ====unfolded( +Collection, ?Coins )==== holds when (part) <var>Collection</var> comprises <var>Coins</var>. <syntaxhighlight lang="prolog"> unfolded( not_light(Collection), Coins ) :- part( not_light, Collection, Coins ). unfolded( not_heavy(Collection), Coins ) :- part( not_heavy, Collection, Coins ). unfolded( known_true(Collection), Coins ) :- part( known_true, Collection, Coins ). unfolded( untested(Collection), Coins ) :- part( untested, Collection, Coins ). unfolded( all(Collection), Coins ) :- collection_to_set( Collection, Coins ). unfolded( [Item|Items], Coins ) :- unfolded( Item, Value ), unfolded1( Items, Value, Coins ). unfolded1( [], Coins, Coins ). unfolded1( [Item|Items], Value, Coins ) :- unfolded( Item, Value0 ), ord_union( Value0, Value, Value1 ), unfolded1( Items, Value1, Coins ). </syntaxhighlight> ==Definite Clause Grammar== The following DCG represents the method for finding the counterfeit coin as a 'structured' procedure. <syntaxhighlight lang="prolog"> general_explanation( Procedure ) --> "Number the coins 1..12", newline, explanation( Procedure, 0 ). explanation( done(Coin, Weight), N ) --> tab( N ), "Conclude that the counterfeit coin is number ", literal( Coin ), ", which is ", literal( Weight ), newline. explanation( Step, N ) --> {step( Step, Left, Right, Table, Branches )}, tab( N ), "BEGIN", newline, tab( N ), "Put ", literal( Left ), " on the left-hand pan", newline, tab( N ), "Put ", literal( Right ), " on the right-hand pan", newline, tab( N ), "Leaving ", literal( Table ), " on the table", newline, branches_explained( Branches, N ), tab( N ), "END", newline. branches_explained( Branches, N ) --> next_step_explained( <, Branches, N ), next_step_explained( >, Branches, N ), next_step_explained( =, Branches, N ). next_step_explained( Result, Branch, N ) --> {branch( Result, Branch, Step )}, ( {var(Step)} -> "" | {nonvar(Step)} -> tab( N ), "If the ", literal( Result ), " then:", newline, explanation( Step, s(N) ) ). literal( 0 ) --> "0". literal( 1 ) --> "1". literal( 2 ) --> "2". literal( 3 ) --> "3". literal( 4 ) --> "4". literal( 5 ) --> "5". literal( 6 ) --> "6". literal( 7 ) --> "7". literal( 8 ) --> "8". literal( 9 ) --> "9". literal( 10 ) --> "10". literal( 11 ) --> "11". literal( 12 ) --> "12". literal( true ) --> "true". literal( heavy ) --> "heavy". literal( light ) --> "light". literal( = ) --> "pans balance". literal( < ) --> "right-hand pan is heavier". literal( > ) --> "left-hand pan is heavier". literal( Collection ) --> {collection_to_set( Collection , [H|T] )}, literal_set( T, H ). literal_set( [], Number ) --> "the coin numbered ", literal( Number ). literal_set( [H|T], Number ) --> "the coins numbered ", literal( Number ), literal_set1( T, H ). literal_set1( [], Number ) --> " and ", literal( Number ). literal_set1( [H|T], Number ) --> ", ", literal( Number ), literal_set1( T, H ). tab( 0 ) --> "". tab( s(N) ) --> " ", tab( N ). newline --> " ". </syntaxhighlight> ===Utility Predicates=== ====contains_coin( ?Collection, ?Coin )==== holds when <var>Coin</var> is a member of <var>Collection</var>. <syntaxhighlight lang="prolog"> contains_coin( Collection, Coin ) :- part( _Part, Collection, Coins ), member( Coin, Coins ). </syntaxhighlight> ====collection_to_set( +Collection, ?Set )==== holds when <var>Set</var> is the distributed union of the <code>known_true</code>, <code>not_heavy</code>, <code>not_light</code> and <code>untested</code> ordsets comprising <var>Collection</var>. <syntaxhighlight lang="prolog"> collection_to_set( Collection, Set ) :- part( known_true, Collection, KnownTrue ), part( not_heavy, Collection, NotHeavy ), part( not_light, Collection, NotLight ), part( untested, Collection, Untested ), ord_union( [KnownTrue,NotHeavy,NotLight,Untested], Set ). </syntaxhighlight> ==== information_content( +Counts, ?Content ) ==== holds when <var>Content</var> is the cumulative negative entropy of <var>Counts</var>. A reduction in entropy equates to a gain in information. <syntaxhighlight lang="prolog"> information_content( Counts, Content ) :- information_content1( Counts, 0, Content ). information_content1( [], Content, Content ). information_content1( [Count|Counts], Content0, Content ):- coins_entropy( Count, Entropy ), Content1 is Content0-Entropy, information_content1( Counts, Content1, Content ). </syntaxhighlight> ==== coins_entropy( ?N, ?Entropy ) ==== holds when <var>Entropy</var> estimates the entropy of a sample of <var>N</var> coins. <var>Entropy</var> = P log₂(1/P), where P = <var>N</var>/12. <syntaxhighlight lang="prolog"> coins_entropy( 0, 0.0 ). coins_entropy( 1, 0.2987 ). coins_entropy( 2, 0.4308 ). coins_entropy( 3, 0.5 ). coins_entropy( 4, 0.5283 ). coins_entropy( 5, 0.5263 ). coins_entropy( 6, 0.5 ). coins_entropy( 7, 0.4536 ). coins_entropy( 8, 0.39 ). coins_entropy( 9, 0.3113 ). coins_entropy( 10, 0.2192 ). coins_entropy( 11, 0.1151 ). coins_entropy( 12, 0.0 ). </syntaxhighlight> ====select_coins( +Part, +Coins, ?Sample, ?Residue, ?N )==== holds when <var>N</var> coins from <var>Part</var> of <var>Coins</var> form <var>Part</var> of <var>Sample</var>, with the remainder forming <var>Part</var> of <var>Residue</var>. <syntaxhighlight lang="prolog"> select_coins( Part, Coins, Sample, Residue, Count ) :- part( Part, Coins, Input ), part( Part, Sample, Selection ), part( Part, Residue, Remainder ), select_n( Count, Input, Selection, Remainder ). select_n( 0, In, [], In ). select_n( 1, [A|Suffix], [A], Suffix ). select_n( 2, [A,B|Suffix], [A,B], Suffix ). select_n( 3, [A,B,C|Suffix], [A,B,C], Suffix ). select_n( 4, [A,B,C,D|Suffix], [A,B,C,D], Suffix ). select_n( 5, [A,B,C,D,E|Suffix], [A,B,C,D,E], Suffix ). select_n( 6, [A,B,C,D,E,F|Suffix], [A,B,C,D,E,F], Suffix ). </syntaxhighlight> Load a small library of [[Puzzle Utilities]]. <syntaxhighlight lang="prolog"> :- ensure_loaded( misc ). </syntaxhighlight> Use the ordsets library. <syntaxhighlight lang="prolog"> :- use_module( library(ordsets), [ord_union/2,ord_union/3] ). </syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/download/counterfeit.txt here]. ==Output== <div class="result"> Number the coins 1..12 BEGIN Put the coins numbered 1, 2, 3 and 4 on the left-hand pan Put the coins numbered 5, 6, 7 and 8 on the right-hand pan Leaving the coins numbered 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 1, 2, 5 and 6 on the left-hand pan Put the coins numbered 3, 7, 9 and 10 on the right-hand pan Leaving the coins numbered 4, 8, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 1 and 7 on the left-hand pan Put the coins numbered 3 and 4 on the right-hand pan Leaving the coins numbered 2, 5, 6, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 1, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 7, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 2, which is light END If the left-hand pan is heavier then: BEGIN Put the coins numbered 3 and 5 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 4, 6, 7, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 3, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 5, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 6, which is heavy END If the pans balance then: BEGIN Put the coins numbered 4 and 8 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 3, 5, 6, 7, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 4, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 8, which is heavy END END If the left-hand pan is heavier then: BEGIN Put the coins numbered 1, 2, 5 and 6 on the left-hand pan Put the coins numbered 3, 7, 9 and 10 on the right-hand pan Leaving the coins numbered 4, 8, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 3 and 5 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 4, 6, 7, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 5, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 3, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 6, which is light END If the left-hand pan is heavier then: BEGIN Put the coins numbered 1 and 7 on the left-hand pan Put the coins numbered 3 and 4 on the right-hand pan Leaving the coins numbered 2, 5, 6, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 7, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 1, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 2, which is heavy END If the pans balance then: BEGIN Put the coins numbered 4 and 8 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 3, 5, 6, 7, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 8, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 4, which is heavy END END If the pans balance then: BEGIN Put the coins numbered 9, 10 and 11 on the left-hand pan Put the coins numbered 1, 2 and 3 on the right-hand pan Leaving the coins numbered 4, 5, 6, 7, 8 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coin numbered 9 on the left-hand pan Put the coin numbered 10 on the right-hand pan Leaving the coins numbered 1, 2, 3, 4, 5, 6, 7, 8, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 9, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 10, which is light If the pans balance then: Conclude that the counterfeit coin is number 11, which is light END If the left-hand pan is heavier then: BEGIN Put the coin numbered 9 on the left-hand pan Put the coin numbered 10 on the right-hand pan Leaving the coins numbered 1, 2, 3, 4, 5, 6, 7, 8, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 10, which is heavy If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 9, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 11, which is heavy END If the pans balance then: BEGIN Put the coin numbered 12 on the left-hand pan Put the coin numbered 1 on the right-hand pan Leaving the coins numbered 2, 3, 4, 5, 6, 7, 8, 9, 10 and 11 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 12, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 12, which is heavy END END END </div> ---- 3b47e6462609dce94e00c219558950881a8e5ef5 61 53 2013-12-22T16:31:24Z John 2 /* Definite Clause Grammar */ wikitext text/x-wiki __NOTOC__ ==Problem Definition== We are given 12 apparently identical coins - one of which is counterfeit. We know that the counterfeit has a different weight from the others, but we don't know if it's heavier or lighter. ===Task:=== Devise a procedure to identify any counterfeit coin using a balance to take up to three comparative weighings. ==Strategy== The information from three suitable weighings will make all but one of the 'coins', which are untested initially, 'known true'. There are three alternative deductions that make a coin 'known true': * if it is 'not heavy' and 'not light' - having been on both the comparatively lighter and heavier sides of imbalances; * if it was excluded from an imbalance; * if it was included in a balanced weighing. After three weighings there must be exactly one coin, the counterfeit, which is not 'true'. If the counterfeit is not true and 'not heavy' we deduce that it must be light. If it is not true and 'not light', it must be heavy. We use a 'generate-and-test' method as follows: * Create the set of all possible 'counterfeits': 12 coins &times; 2 weights ; * Devise a procedure that can identify the first counterfeit coin; * Show that the same procedure works for every other counterfeit. ==Entry Point== ====go==== is the entry point. It solves the puzzle, then uses a DCG to pretty-print the resulting procedure. <syntaxhighlight lang="prolog"> go :- coins_puzzle( Procedure ), phrase( general_explanation( Procedure ), Chars ), put_chars( Chars ). </syntaxhighlight> ====coins_puzzle( ?Procedure )==== generates the set of all possible 'counterfeits' and finds (or proves) that <var>Procedure</var> can identify them all. <syntaxhighlight lang="prolog"> coins_puzzle( Procedure ) :- coins( Coins ), counterfeit( Counterfeit, Coin, Weight ), findall( Counterfeit, (member(Coin,Coins), counterfeit_weight(Weight)), Counterfeits ), coins_puzzle_solution( Counterfeits, Procedure ). coins_puzzle_solution( [], _Procedure ). coins_puzzle_solution( [Counterfeit|Counterfeits], Procedure ) :- solve_coins( Counterfeit, Procedure ), coins_puzzle_solution( Counterfeits, Procedure ). </syntaxhighlight> A procedure is either 'done', identifying a particular coin and whether it is 'heavy' or 'light'; or it is a 'step'. A step defines the coins to be placed on the <var>Left</var> and <var>Right</var> pans, with the residue remaining on the <var>Table</var>, and three <var>Branches</var>, one of which will be chosen depending on the outcome of the weighing. <syntaxhighlight lang="prolog"> step( step(Left,Right,Table,Branches), Left, Right, Table, Branches). </syntaxhighlight> The <var>Branches</var> are three procedures equating to: * > (left pan heavier), * < (right pan heavier) and * <nowiki>= (pans balance).</nowiki> <syntaxhighlight lang="prolog"> branch( >, branches(_Equal, GT, _LT), GT ). branch( <, branches(_Equal, _GT, LT), LT ). branch( =, branches(Equal, _GT, _LT), Equal ). </syntaxhighlight> The counterfeit is defined by its number and whether it is heavy or light. <syntaxhighlight lang="prolog"> counterfeit( counterfeit(Coin, HeavyOrLight), Coin, HeavyOrLight ). coins( [1,2,3,4,5,6,7,8,9,10,11,12] ). counterfeit_weight( heavy ). counterfeit_weight( light ). </syntaxhighlight> A 'coin collection' comprises four 'parts' (subsets): the <code>known_true</code>, <code>not_heavy</code>, <code>not_light</code> and <code>untested</code> sets of coins. <syntaxhighlight lang="prolog"> part( known_true, collection(Coins,_,_,_), Coins ). part( not_heavy, collection(_,Coins,_,_), Coins ). part( not_light, collection(_,_,Coins,_), Coins ). part( untested, collection(_,_,_,Coins), Coins ). </syntaxhighlight> ==Solution== ====solve_coins( +Counterfeit, ?Procedure )==== holds when <var>Procedure</var> can correctly identify the <var>Counterfeit</var> coin. Beginning with a 'start' collection, in which all the coins are untested, the <var>Procedure</var> comprises three 'steps'. For each step a 'weighing' is made and a 'branch' is made in the <var>Procedure</var>, depending on the result of the weighing. After three steps, the <var>Procedure</var> must have reached the 'end' condition. Finally, an assertion (redundant test) ensures that the <var>Procedure</var> has found the correct end condition. <syntaxhighlight lang="prolog"> solve_coins( Counterfeit, Procedure ) :- start( Coins0 ), assay( Counterfeit, Coins0, Procedure, Branch1, Coins1 ), assay( Counterfeit, Coins1, Branch1, Branch2, Coins2 ), assay( Counterfeit, Coins2, Branch2, done(Coin, HeavyOrLight), Coins3 ), end( Coins3, Coin, HeavyOrLight ), counterfeit( Counterfeit, Coin, HeavyOrLight ). start( Coins ) :- coins( Untested ), part( untested, Coins, Untested ), part( not_heavy, Coins, [] ), part( not_light, Coins, [] ), part( known_true, Coins, [] ). end( Coins, Coin, HeavyOrLight ) :- part( untested, Coins, [] ), part( not_heavy, Coins, Light ), part( not_light, Coins, Heavy ), end_result( Heavy, Light, Coin, HeavyOrLight ). end_result( [Coin], [], Coin, heavy ). end_result( [], [Coin], Coin, light ). </syntaxhighlight> === Simulating the weighing process === ====assay( +Counterfeit, +Coins0, ?Step, ?Branch, ?Coins1 )==== holds when the appropriate <var>Branch</var> from <var>Step</var> is chosen by comparing the weights of two coin collections taken from the full set of coins: <var>Coins0</var>. <var>Coins1</var> is the full set of coins, updated with the inferences drawn from the weighing. <var>Counterfeit</var> is used to determine the result of the weighing. This predicate applies the critical insight into the solution of this puzzle: we have 24 (12 &times; 2) possible inputs to the procedure, with only 27 (3 &times; 3 &times; 3) possible outcomes from the weighings. Therefore, it is clear that each weighing must have a very high 'information content'. Choosing which weighing to make by estimating the available information content makes the problem tractable. <syntaxhighlight lang="prolog"> assay( Counterfeit, Coins0, Step, Branch, Coins ) :- WeighingDatum = weighing_data(InfoContent, Left, Right, Table), step( Step, Left, Right, Table, Branches ), findall( WeighingDatum, valid_partition( Coins0, InfoContent, Left, Right, Table ), WeighingData ), sort( WeighingData, OrderedWeighingData ), member( WeighingDatum, OrderedWeighingData ), balance( Left, Right, Counterfeit, Result ), draw_inferences( Result, Left, Right, Table, Coins ), branch( Result, Branches, Branch ). </syntaxhighlight> ====balance( +Left, +Right, +Counterfeit, ?Result )==== holds when <var>Result</var> simulates the outcome of testing the coin collections <var>Left</var> and <var>Right</var> with a balance, where either may contain the <var>Counterfeit</var> coin. <syntaxhighlight lang="prolog"> balance( Left, Right, Counterfeit, Result ):- counterfeit( Counterfeit, Coin, Weight ), ( contains_coin( Left, Coin ) -> balance_result( Weight, normal, Result ) ; contains_coin( Right, Coin ) -> balance_result( normal, Weight, Result ) ; otherwise -> Result = '=' ). balance_result( light, normal, < ). balance_result( heavy, normal, > ). balance_result( normal, heavy, < ). balance_result( normal, light, > ). </syntaxhighlight> ===Choosing which coins to weigh=== ====valid_partition( +Coins, ?Content, ?Left, ?Right, ?Table )==== holds when <var>Coins</var> can be partitioned into three collections: <var>Left</var> side, <var>Right</var> side and <var>Table</var>; with the 'information content' of the partition given by <var>Content</var>. The definition of a 'valid partition' ensures that: * <var>Left</var> and <var>Right</var> must have the same number of coins (at least one); * <var>Left</var> cannot contain any known 'true' coins, because adding true coins to both sides creates redundant comparisons. A 'checksum' is used to ensure that only one member of each pair of symmetrical solutions can be generated. <syntaxhighlight lang="prolog"> valid_partition( Coins, Content, Left, Right, Table ):- part( known_true, Left, [] ), selection( Coins, Left, Coins1, Count, LeftChecksum, LeftInfo ), Count >= 1, selection( Coins1, Right, Table, Count, RightChecksum, RightInfo ), LeftChecksum =< RightChecksum, % Checksum to prevent symmetrical solutions table_information( Table, TableInfo ), sum( [LeftInfo,RightInfo,TableInfo], Content ). </syntaxhighlight> ====selection( +Coins, ?Sample, ?Residue, ?Count, ?Checksum, ?Content )==== holds when <var>Coins</var> is partitioned into two collections: <var>Sample</var> and <var>Residue</var>. <var>Count</var> is the number of coins in <var>Sample</var>. <var>Checksum</var> is a fingerprint for the mixture of coins in <var>Sample</var>, which has 'information content' <var>Content</var>. <syntaxhighlight lang="prolog"> selection( Coins, Sample, Residue, Count, Checksum, Content ) :- select_coins( not_heavy, Coins, Sample, Residue, Count1 ), select_coins( not_light, Coins, Sample, Residue, Count2 ), select_coins( untested, Coins, Sample, Residue, Count3 ), select_coins( known_true, Coins, Sample, Residue, Count4 ), Count is Count1+Count2+Count3+Count4, Count =< 6, Checksum is Count1+(7*Count2)+(43*Count3)+(259*Count4), information_content( [Count1,Count2,Count3,Count4], Content ). </syntaxhighlight> ====table_information( +Coins, ?Content )==== holds when <var>Coins</var> has 'information content' <var>Content</var>. <syntaxhighlight lang="prolog"> table_information( Coins, Content ) :- count_coins( not_heavy, Coins, Count1 ), count_coins( not_light, Coins, Count2 ), count_coins( untested, Coins, Count3 ), count_coins( known_true, Coins, Count4 ), information_content( [Count1,Count2,Count3,Count4], Content ). count_coins( Part, Coins, Count ) :- part( Part, Coins, Selection ), length( Selection, Count ). </syntaxhighlight> === Updating what is known about the coins === ====draw_inferences( +Result, +Left, +Right, +Table, ?Coins )==== holds when <var>Result</var> is one of: * > (imbalance - left pan heavier), * < (imbalance - right pan heavier) or * <nowiki>=</nowiki> (pans balanced) from taking a weighing with the coin collections: <var>Left</var>, <var>Right</var> and <var>Table</var>. <var>Coins</var> is derived from this information using the following rules: * If the pans are unbalanced then only the previously untested or not_heavy coins on the lighter side of the balance are now not_heavy. Similarly, only the previously untested or not_light coins on the heavier side of the balance are now not_light. All the coins on the table are now known_true. * If the pans balance then all the coins weighed are known_true, with the coins on the <var>Table</var> left in their prior states. <syntaxhighlight lang="prolog"> draw_inferences( <, Left, Right, Table, Coins ) :- imbalance_inferences( Left, Right, Table, Coins ). draw_inferences( >, Left, Right, Table, Coins ) :- imbalance_inferences( Right, Left, Table, Coins ). draw_inferences( =, Left, Right, Table, Coins ) :- becomes( [all(Left),known_true(Table),all(Right)], known_true( Coins ) ), becomes( untested(Table), untested(Coins) ), becomes( not_heavy(Table), not_heavy(Coins) ), becomes( not_light(Table), not_light(Coins) ). </syntaxhighlight> ====imbalance_inferences( +Lighter, +Heavier, +Table, ?Coins )==== holds when: * All untested or not_heavy coins in <var>Lighter</var> are not_heavy in <var>Coins</var>; * All untested or not_light coins in <var>Heavier</var> are not_light in <var>Coins</var>; * All coins in <var>Table</var> are known_true in <var>Coins</var>; There are no untested coins in <var>Coins</var>. <syntaxhighlight lang="prolog"> imbalance_inferences( Lighter, Heavier, Table, Coins ) :- becomes( [untested(Lighter),not_heavy(Lighter)], not_heavy(Coins) ), becomes( [untested(Heavier),not_light(Heavier)], not_light(Coins) ), becomes( [ known_true(Lighter), not_light(Lighter), known_true(Heavier), not_heavy(Heavier), all(Table) ], known_true(Coins) ), part( untested, Coins, [] ). </syntaxhighlight> ====becomes( +CollectionA, ?CollectionB )==== <var>CollectionA</var> becomes (part) <var>CollectionB</var> when <var>CollectionB</var> comprises the same coins as <var>CollectionA</var>. <syntaxhighlight lang="prolog"> becomes( CollectionA, CollectionB ) :- unfolded( CollectionA, Coins ), unfolded( CollectionB, Coins ). </syntaxhighlight> ====unfolded( +Collection, ?Coins )==== holds when (part) <var>Collection</var> comprises <var>Coins</var>. <syntaxhighlight lang="prolog"> unfolded( not_light(Collection), Coins ) :- part( not_light, Collection, Coins ). unfolded( not_heavy(Collection), Coins ) :- part( not_heavy, Collection, Coins ). unfolded( known_true(Collection), Coins ) :- part( known_true, Collection, Coins ). unfolded( untested(Collection), Coins ) :- part( untested, Collection, Coins ). unfolded( all(Collection), Coins ) :- collection_to_set( Collection, Coins ). unfolded( [Item|Items], Coins ) :- unfolded( Item, Value ), unfolded1( Items, Value, Coins ). unfolded1( [], Coins, Coins ). unfolded1( [Item|Items], Value, Coins ) :- unfolded( Item, Value0 ), ord_union( Value0, Value, Value1 ), unfolded1( Items, Value1, Coins ). </syntaxhighlight> ==Definite Clause Grammar== The following DCG represents the method for finding the counterfeit coin as a structured procedure. <syntaxhighlight lang="prolog"> general_explanation( Procedure ) --> "Number the coins 1..12", newline, explanation( Procedure, 0 ). explanation( done(Coin, Weight), N ) --> tab( N ), "Conclude that the counterfeit coin is number ", literal( Coin ), ", which is ", literal( Weight ), newline. explanation( Step, N ) --> {step( Step, Left, Right, Table, Branches )}, tab( N ), "BEGIN", newline, tab( N ), "Put ", literal( Left ), " on the left-hand pan", newline, tab( N ), "Put ", literal( Right ), " on the right-hand pan", newline, tab( N ), "Leaving ", literal( Table ), " on the table", newline, branches_explained( Branches, N ), tab( N ), "END", newline. branches_explained( Branches, N ) --> next_step_explained( <, Branches, N ), next_step_explained( >, Branches, N ), next_step_explained( =, Branches, N ). next_step_explained( Result, Branch, N ) --> {branch( Result, Branch, Step )}, ( {var(Step)} -> "" | {nonvar(Step)} -> tab( N ), "If the ", literal( Result ), " then:", newline, explanation( Step, s(N) ) ). literal( 0 ) --> "0". literal( 1 ) --> "1". literal( 2 ) --> "2". literal( 3 ) --> "3". literal( 4 ) --> "4". literal( 5 ) --> "5". literal( 6 ) --> "6". literal( 7 ) --> "7". literal( 8 ) --> "8". literal( 9 ) --> "9". literal( 10 ) --> "10". literal( 11 ) --> "11". literal( 12 ) --> "12". literal( true ) --> "true". literal( heavy ) --> "heavy". literal( light ) --> "light". literal( = ) --> "pans balance". literal( < ) --> "right-hand pan is heavier". literal( > ) --> "left-hand pan is heavier". literal( Collection ) --> {collection_to_set( Collection , [H|T] )}, literal_set( T, H ). literal_set( [], Number ) --> "the coin numbered ", literal( Number ). literal_set( [H|T], Number ) --> "the coins numbered ", literal( Number ), literal_set1( T, H ). literal_set1( [], Number ) --> " and ", literal( Number ). literal_set1( [H|T], Number ) --> ", ", literal( Number ), literal_set1( T, H ). tab( 0 ) --> "". tab( s(N) ) --> " ", tab( N ). newline --> " ". </syntaxhighlight> ===Utility Predicates=== ====contains_coin( ?Collection, ?Coin )==== holds when <var>Coin</var> is a member of <var>Collection</var>. <syntaxhighlight lang="prolog"> contains_coin( Collection, Coin ) :- part( _Part, Collection, Coins ), member( Coin, Coins ). </syntaxhighlight> ====collection_to_set( +Collection, ?Set )==== holds when <var>Set</var> is the distributed union of the <code>known_true</code>, <code>not_heavy</code>, <code>not_light</code> and <code>untested</code> ordsets comprising <var>Collection</var>. <syntaxhighlight lang="prolog"> collection_to_set( Collection, Set ) :- part( known_true, Collection, KnownTrue ), part( not_heavy, Collection, NotHeavy ), part( not_light, Collection, NotLight ), part( untested, Collection, Untested ), ord_union( [KnownTrue,NotHeavy,NotLight,Untested], Set ). </syntaxhighlight> ==== information_content( +Counts, ?Content ) ==== holds when <var>Content</var> is the cumulative negative entropy of <var>Counts</var>. A reduction in entropy equates to a gain in information. <syntaxhighlight lang="prolog"> information_content( Counts, Content ) :- information_content1( Counts, 0, Content ). information_content1( [], Content, Content ). information_content1( [Count|Counts], Content0, Content ):- coins_entropy( Count, Entropy ), Content1 is Content0-Entropy, information_content1( Counts, Content1, Content ). </syntaxhighlight> ==== coins_entropy( ?N, ?Entropy ) ==== holds when <var>Entropy</var> estimates the entropy of a sample of <var>N</var> coins. <var>Entropy</var> = P log₂(1/P), where P = <var>N</var>/12. <syntaxhighlight lang="prolog"> coins_entropy( 0, 0.0 ). coins_entropy( 1, 0.2987 ). coins_entropy( 2, 0.4308 ). coins_entropy( 3, 0.5 ). coins_entropy( 4, 0.5283 ). coins_entropy( 5, 0.5263 ). coins_entropy( 6, 0.5 ). coins_entropy( 7, 0.4536 ). coins_entropy( 8, 0.39 ). coins_entropy( 9, 0.3113 ). coins_entropy( 10, 0.2192 ). coins_entropy( 11, 0.1151 ). coins_entropy( 12, 0.0 ). </syntaxhighlight> ====select_coins( +Part, +Coins, ?Sample, ?Residue, ?N )==== holds when <var>N</var> coins from <var>Part</var> of <var>Coins</var> form <var>Part</var> of <var>Sample</var>, with the remainder forming <var>Part</var> of <var>Residue</var>. <syntaxhighlight lang="prolog"> select_coins( Part, Coins, Sample, Residue, Count ) :- part( Part, Coins, Input ), part( Part, Sample, Selection ), part( Part, Residue, Remainder ), select_n( Count, Input, Selection, Remainder ). select_n( 0, In, [], In ). select_n( 1, [A|Suffix], [A], Suffix ). select_n( 2, [A,B|Suffix], [A,B], Suffix ). select_n( 3, [A,B,C|Suffix], [A,B,C], Suffix ). select_n( 4, [A,B,C,D|Suffix], [A,B,C,D], Suffix ). select_n( 5, [A,B,C,D,E|Suffix], [A,B,C,D,E], Suffix ). select_n( 6, [A,B,C,D,E,F|Suffix], [A,B,C,D,E,F], Suffix ). </syntaxhighlight> Load a small library of [[Puzzle Utilities]]. <syntaxhighlight lang="prolog"> :- ensure_loaded( misc ). </syntaxhighlight> Use the ordsets library. <syntaxhighlight lang="prolog"> :- use_module( library(ordsets), [ord_union/2,ord_union/3] ). </syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/download/counterfeit.txt here]. ==Output== <div class="result"> Number the coins 1..12 BEGIN Put the coins numbered 1, 2, 3 and 4 on the left-hand pan Put the coins numbered 5, 6, 7 and 8 on the right-hand pan Leaving the coins numbered 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 1, 2, 5 and 6 on the left-hand pan Put the coins numbered 3, 7, 9 and 10 on the right-hand pan Leaving the coins numbered 4, 8, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 1 and 7 on the left-hand pan Put the coins numbered 3 and 4 on the right-hand pan Leaving the coins numbered 2, 5, 6, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 1, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 7, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 2, which is light END If the left-hand pan is heavier then: BEGIN Put the coins numbered 3 and 5 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 4, 6, 7, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 3, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 5, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 6, which is heavy END If the pans balance then: BEGIN Put the coins numbered 4 and 8 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 3, 5, 6, 7, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 4, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 8, which is heavy END END If the left-hand pan is heavier then: BEGIN Put the coins numbered 1, 2, 5 and 6 on the left-hand pan Put the coins numbered 3, 7, 9 and 10 on the right-hand pan Leaving the coins numbered 4, 8, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 3 and 5 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 4, 6, 7, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 5, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 3, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 6, which is light END If the left-hand pan is heavier then: BEGIN Put the coins numbered 1 and 7 on the left-hand pan Put the coins numbered 3 and 4 on the right-hand pan Leaving the coins numbered 2, 5, 6, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 7, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 1, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 2, which is heavy END If the pans balance then: BEGIN Put the coins numbered 4 and 8 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 3, 5, 6, 7, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 8, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 4, which is heavy END END If the pans balance then: BEGIN Put the coins numbered 9, 10 and 11 on the left-hand pan Put the coins numbered 1, 2 and 3 on the right-hand pan Leaving the coins numbered 4, 5, 6, 7, 8 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coin numbered 9 on the left-hand pan Put the coin numbered 10 on the right-hand pan Leaving the coins numbered 1, 2, 3, 4, 5, 6, 7, 8, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 9, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 10, which is light If the pans balance then: Conclude that the counterfeit coin is number 11, which is light END If the left-hand pan is heavier then: BEGIN Put the coin numbered 9 on the left-hand pan Put the coin numbered 10 on the right-hand pan Leaving the coins numbered 1, 2, 3, 4, 5, 6, 7, 8, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 10, which is heavy If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 9, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 11, which is heavy END If the pans balance then: BEGIN Put the coin numbered 12 on the left-hand pan Put the coin numbered 1 on the right-hand pan Leaving the coins numbered 2, 3, 4, 5, 6, 7, 8, 9, 10 and 11 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 12, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 12, which is heavy END END END </div> ---- 3517d380aa6088831eb42f42a34cdb6b85b95ee6 90 61 2015-01-30T13:42:21Z John 2 /* selection( +Coins, ?Sample, ?Residue, ?Count, ?Checksum, ?Content ) */ wikitext text/x-wiki __NOTOC__ ==Problem Definition== We are given 12 apparently identical coins - one of which is counterfeit. We know that the counterfeit has a different weight from the others, but we don't know if it's heavier or lighter. ===Task:=== Devise a procedure to identify any counterfeit coin using a balance to take up to three comparative weighings. ==Strategy== The information from three suitable weighings will make all but one of the 'coins', which are untested initially, 'known true'. There are three alternative deductions that make a coin 'known true': * if it is 'not heavy' and 'not light' - having been on both the comparatively lighter and heavier sides of imbalances; * if it was excluded from an imbalance; * if it was included in a balanced weighing. After three weighings there must be exactly one coin, the counterfeit, which is not 'true'. If the counterfeit is not true and 'not heavy' we deduce that it must be light. If it is not true and 'not light', it must be heavy. We use a 'generate-and-test' method as follows: * Create the set of all possible 'counterfeits': 12 coins &times; 2 weights ; * Devise a procedure that can identify the first counterfeit coin; * Show that the same procedure works for every other counterfeit. ==Entry Point== ====go==== is the entry point. It solves the puzzle, then uses a DCG to pretty-print the resulting procedure. <syntaxhighlight lang="prolog"> go :- coins_puzzle( Procedure ), phrase( general_explanation( Procedure ), Chars ), put_chars( Chars ). </syntaxhighlight> ====coins_puzzle( ?Procedure )==== generates the set of all possible 'counterfeits' and finds (or proves) that <var>Procedure</var> can identify them all. <syntaxhighlight lang="prolog"> coins_puzzle( Procedure ) :- coins( Coins ), counterfeit( Counterfeit, Coin, Weight ), findall( Counterfeit, (member(Coin,Coins), counterfeit_weight(Weight)), Counterfeits ), coins_puzzle_solution( Counterfeits, Procedure ). coins_puzzle_solution( [], _Procedure ). coins_puzzle_solution( [Counterfeit|Counterfeits], Procedure ) :- solve_coins( Counterfeit, Procedure ), coins_puzzle_solution( Counterfeits, Procedure ). </syntaxhighlight> A procedure is either 'done', identifying a particular coin and whether it is 'heavy' or 'light'; or it is a 'step'. A step defines the coins to be placed on the <var>Left</var> and <var>Right</var> pans, with the residue remaining on the <var>Table</var>, and three <var>Branches</var>, one of which will be chosen depending on the outcome of the weighing. <syntaxhighlight lang="prolog"> step( step(Left,Right,Table,Branches), Left, Right, Table, Branches). </syntaxhighlight> The <var>Branches</var> are three procedures equating to: * > (left pan heavier), * < (right pan heavier) and * <nowiki>= (pans balance).</nowiki> <syntaxhighlight lang="prolog"> branch( >, branches(_Equal, GT, _LT), GT ). branch( <, branches(_Equal, _GT, LT), LT ). branch( =, branches(Equal, _GT, _LT), Equal ). </syntaxhighlight> The counterfeit is defined by its number and whether it is heavy or light. <syntaxhighlight lang="prolog"> counterfeit( counterfeit(Coin, HeavyOrLight), Coin, HeavyOrLight ). coins( [1,2,3,4,5,6,7,8,9,10,11,12] ). counterfeit_weight( heavy ). counterfeit_weight( light ). </syntaxhighlight> A 'coin collection' comprises four 'parts' (subsets): the <code>known_true</code>, <code>not_heavy</code>, <code>not_light</code> and <code>untested</code> sets of coins. <syntaxhighlight lang="prolog"> part( known_true, collection(Coins,_,_,_), Coins ). part( not_heavy, collection(_,Coins,_,_), Coins ). part( not_light, collection(_,_,Coins,_), Coins ). part( untested, collection(_,_,_,Coins), Coins ). </syntaxhighlight> ==Solution== ====solve_coins( +Counterfeit, ?Procedure )==== holds when <var>Procedure</var> can correctly identify the <var>Counterfeit</var> coin. Beginning with a 'start' collection, in which all the coins are untested, the <var>Procedure</var> comprises three 'steps'. For each step a 'weighing' is made and a 'branch' is made in the <var>Procedure</var>, depending on the result of the weighing. After three steps, the <var>Procedure</var> must have reached the 'end' condition. Finally, an assertion (redundant test) ensures that the <var>Procedure</var> has found the correct end condition. <syntaxhighlight lang="prolog"> solve_coins( Counterfeit, Procedure ) :- start( Coins0 ), assay( Counterfeit, Coins0, Procedure, Branch1, Coins1 ), assay( Counterfeit, Coins1, Branch1, Branch2, Coins2 ), assay( Counterfeit, Coins2, Branch2, done(Coin, HeavyOrLight), Coins3 ), end( Coins3, Coin, HeavyOrLight ), counterfeit( Counterfeit, Coin, HeavyOrLight ). start( Coins ) :- coins( Untested ), part( untested, Coins, Untested ), part( not_heavy, Coins, [] ), part( not_light, Coins, [] ), part( known_true, Coins, [] ). end( Coins, Coin, HeavyOrLight ) :- part( untested, Coins, [] ), part( not_heavy, Coins, Light ), part( not_light, Coins, Heavy ), end_result( Heavy, Light, Coin, HeavyOrLight ). end_result( [Coin], [], Coin, heavy ). end_result( [], [Coin], Coin, light ). </syntaxhighlight> === Simulating the weighing process === ====assay( +Counterfeit, +Coins0, ?Step, ?Branch, ?Coins1 )==== holds when the appropriate <var>Branch</var> from <var>Step</var> is chosen by comparing the weights of two coin collections taken from the full set of coins: <var>Coins0</var>. <var>Coins1</var> is the full set of coins, updated with the inferences drawn from the weighing. <var>Counterfeit</var> is used to determine the result of the weighing. This predicate applies the critical insight into the solution of this puzzle: we have 24 (12 &times; 2) possible inputs to the procedure, with only 27 (3 &times; 3 &times; 3) possible outcomes from the weighings. Therefore, it is clear that each weighing must have a very high 'information content'. Choosing which weighing to make by estimating the available information content makes the problem tractable. <syntaxhighlight lang="prolog"> assay( Counterfeit, Coins0, Step, Branch, Coins ) :- WeighingDatum = weighing_data(InfoContent, Left, Right, Table), step( Step, Left, Right, Table, Branches ), findall( WeighingDatum, valid_partition( Coins0, InfoContent, Left, Right, Table ), WeighingData ), sort( WeighingData, OrderedWeighingData ), member( WeighingDatum, OrderedWeighingData ), balance( Left, Right, Counterfeit, Result ), draw_inferences( Result, Left, Right, Table, Coins ), branch( Result, Branches, Branch ). </syntaxhighlight> ====balance( +Left, +Right, +Counterfeit, ?Result )==== holds when <var>Result</var> simulates the outcome of testing the coin collections <var>Left</var> and <var>Right</var> with a balance, where either may contain the <var>Counterfeit</var> coin. <syntaxhighlight lang="prolog"> balance( Left, Right, Counterfeit, Result ):- counterfeit( Counterfeit, Coin, Weight ), ( contains_coin( Left, Coin ) -> balance_result( Weight, normal, Result ) ; contains_coin( Right, Coin ) -> balance_result( normal, Weight, Result ) ; otherwise -> Result = '=' ). balance_result( light, normal, < ). balance_result( heavy, normal, > ). balance_result( normal, heavy, < ). balance_result( normal, light, > ). </syntaxhighlight> ===Choosing which coins to weigh=== ====valid_partition( +Coins, ?Content, ?Left, ?Right, ?Table )==== holds when <var>Coins</var> can be partitioned into three collections: <var>Left</var> side, <var>Right</var> side and <var>Table</var>; with the 'information content' of the partition given by <var>Content</var>. The definition of a 'valid partition' ensures that: * <var>Left</var> and <var>Right</var> must have the same number of coins (at least one); * <var>Left</var> cannot contain any known 'true' coins, because adding true coins to both sides creates redundant comparisons. A 'checksum' is used to ensure that only one member of each pair of symmetrical solutions can be generated. <syntaxhighlight lang="prolog"> valid_partition( Coins, Content, Left, Right, Table ):- part( known_true, Left, [] ), selection( Coins, Left, Coins1, Count, LeftChecksum, LeftInfo ), Count >= 1, selection( Coins1, Right, Table, Count, RightChecksum, RightInfo ), LeftChecksum =< RightChecksum, % Checksum to prevent symmetrical solutions table_information( Table, TableInfo ), sum( [LeftInfo,RightInfo,TableInfo], Content ). </syntaxhighlight> ====selection( +Coins, ?Sample, ?Residue, ?Count, ?Checksum, ?Content )==== holds when <var>Coins</var> is partitioned into two collections: <var>Sample</var> and <var>Residue</var>. <var>Count</var> is the number of coins in <var>Sample</var>. <var>Checksum</var> is a fingerprint for the mixture of coins in <var>Sample</var>, which has estimated information <var>Content</var>. <syntaxhighlight lang="prolog"> selection( Coins, Sample, Residue, Count, Checksum, Content ) :- select_coins( not_heavy, Coins, Sample, Residue, Count1 ), select_coins( not_light, Coins, Sample, Residue, Count2 ), select_coins( untested, Coins, Sample, Residue, Count3 ), select_coins( known_true, Coins, Sample, Residue, Count4 ), Count is Count1+Count2+Count3+Count4, Count =< 6, Checksum is Count1+(7*Count2)+(43*Count3)+(259*Count4), information_content( [Count1,Count2,Count3,Count4], Content ). </syntaxhighlight> ====table_information( +Coins, ?Content )==== holds when <var>Coins</var> has 'information content' <var>Content</var>. <syntaxhighlight lang="prolog"> table_information( Coins, Content ) :- count_coins( not_heavy, Coins, Count1 ), count_coins( not_light, Coins, Count2 ), count_coins( untested, Coins, Count3 ), count_coins( known_true, Coins, Count4 ), information_content( [Count1,Count2,Count3,Count4], Content ). count_coins( Part, Coins, Count ) :- part( Part, Coins, Selection ), length( Selection, Count ). </syntaxhighlight> === Updating what is known about the coins === ====draw_inferences( +Result, +Left, +Right, +Table, ?Coins )==== holds when <var>Result</var> is one of: * > (imbalance - left pan heavier), * < (imbalance - right pan heavier) or * <nowiki>=</nowiki> (pans balanced) from taking a weighing with the coin collections: <var>Left</var>, <var>Right</var> and <var>Table</var>. <var>Coins</var> is derived from this information using the following rules: * If the pans are unbalanced then only the previously untested or not_heavy coins on the lighter side of the balance are now not_heavy. Similarly, only the previously untested or not_light coins on the heavier side of the balance are now not_light. All the coins on the table are now known_true. * If the pans balance then all the coins weighed are known_true, with the coins on the <var>Table</var> left in their prior states. <syntaxhighlight lang="prolog"> draw_inferences( <, Left, Right, Table, Coins ) :- imbalance_inferences( Left, Right, Table, Coins ). draw_inferences( >, Left, Right, Table, Coins ) :- imbalance_inferences( Right, Left, Table, Coins ). draw_inferences( =, Left, Right, Table, Coins ) :- becomes( [all(Left),known_true(Table),all(Right)], known_true( Coins ) ), becomes( untested(Table), untested(Coins) ), becomes( not_heavy(Table), not_heavy(Coins) ), becomes( not_light(Table), not_light(Coins) ). </syntaxhighlight> ====imbalance_inferences( +Lighter, +Heavier, +Table, ?Coins )==== holds when: * All untested or not_heavy coins in <var>Lighter</var> are not_heavy in <var>Coins</var>; * All untested or not_light coins in <var>Heavier</var> are not_light in <var>Coins</var>; * All coins in <var>Table</var> are known_true in <var>Coins</var>; There are no untested coins in <var>Coins</var>. <syntaxhighlight lang="prolog"> imbalance_inferences( Lighter, Heavier, Table, Coins ) :- becomes( [untested(Lighter),not_heavy(Lighter)], not_heavy(Coins) ), becomes( [untested(Heavier),not_light(Heavier)], not_light(Coins) ), becomes( [ known_true(Lighter), not_light(Lighter), known_true(Heavier), not_heavy(Heavier), all(Table) ], known_true(Coins) ), part( untested, Coins, [] ). </syntaxhighlight> ====becomes( +CollectionA, ?CollectionB )==== <var>CollectionA</var> becomes (part) <var>CollectionB</var> when <var>CollectionB</var> comprises the same coins as <var>CollectionA</var>. <syntaxhighlight lang="prolog"> becomes( CollectionA, CollectionB ) :- unfolded( CollectionA, Coins ), unfolded( CollectionB, Coins ). </syntaxhighlight> ====unfolded( +Collection, ?Coins )==== holds when (part) <var>Collection</var> comprises <var>Coins</var>. <syntaxhighlight lang="prolog"> unfolded( not_light(Collection), Coins ) :- part( not_light, Collection, Coins ). unfolded( not_heavy(Collection), Coins ) :- part( not_heavy, Collection, Coins ). unfolded( known_true(Collection), Coins ) :- part( known_true, Collection, Coins ). unfolded( untested(Collection), Coins ) :- part( untested, Collection, Coins ). unfolded( all(Collection), Coins ) :- collection_to_set( Collection, Coins ). unfolded( [Item|Items], Coins ) :- unfolded( Item, Value ), unfolded1( Items, Value, Coins ). unfolded1( [], Coins, Coins ). unfolded1( [Item|Items], Value, Coins ) :- unfolded( Item, Value0 ), ord_union( Value0, Value, Value1 ), unfolded1( Items, Value1, Coins ). </syntaxhighlight> ==Definite Clause Grammar== The following DCG represents the method for finding the counterfeit coin as a structured procedure. <syntaxhighlight lang="prolog"> general_explanation( Procedure ) --> "Number the coins 1..12", newline, explanation( Procedure, 0 ). explanation( done(Coin, Weight), N ) --> tab( N ), "Conclude that the counterfeit coin is number ", literal( Coin ), ", which is ", literal( Weight ), newline. explanation( Step, N ) --> {step( Step, Left, Right, Table, Branches )}, tab( N ), "BEGIN", newline, tab( N ), "Put ", literal( Left ), " on the left-hand pan", newline, tab( N ), "Put ", literal( Right ), " on the right-hand pan", newline, tab( N ), "Leaving ", literal( Table ), " on the table", newline, branches_explained( Branches, N ), tab( N ), "END", newline. branches_explained( Branches, N ) --> next_step_explained( <, Branches, N ), next_step_explained( >, Branches, N ), next_step_explained( =, Branches, N ). next_step_explained( Result, Branch, N ) --> {branch( Result, Branch, Step )}, ( {var(Step)} -> "" | {nonvar(Step)} -> tab( N ), "If the ", literal( Result ), " then:", newline, explanation( Step, s(N) ) ). literal( 0 ) --> "0". literal( 1 ) --> "1". literal( 2 ) --> "2". literal( 3 ) --> "3". literal( 4 ) --> "4". literal( 5 ) --> "5". literal( 6 ) --> "6". literal( 7 ) --> "7". literal( 8 ) --> "8". literal( 9 ) --> "9". literal( 10 ) --> "10". literal( 11 ) --> "11". literal( 12 ) --> "12". literal( true ) --> "true". literal( heavy ) --> "heavy". literal( light ) --> "light". literal( = ) --> "pans balance". literal( < ) --> "right-hand pan is heavier". literal( > ) --> "left-hand pan is heavier". literal( Collection ) --> {collection_to_set( Collection , [H|T] )}, literal_set( T, H ). literal_set( [], Number ) --> "the coin numbered ", literal( Number ). literal_set( [H|T], Number ) --> "the coins numbered ", literal( Number ), literal_set1( T, H ). literal_set1( [], Number ) --> " and ", literal( Number ). literal_set1( [H|T], Number ) --> ", ", literal( Number ), literal_set1( T, H ). tab( 0 ) --> "". tab( s(N) ) --> " ", tab( N ). newline --> " ". </syntaxhighlight> ===Utility Predicates=== ====contains_coin( ?Collection, ?Coin )==== holds when <var>Coin</var> is a member of <var>Collection</var>. <syntaxhighlight lang="prolog"> contains_coin( Collection, Coin ) :- part( _Part, Collection, Coins ), member( Coin, Coins ). </syntaxhighlight> ====collection_to_set( +Collection, ?Set )==== holds when <var>Set</var> is the distributed union of the <code>known_true</code>, <code>not_heavy</code>, <code>not_light</code> and <code>untested</code> ordsets comprising <var>Collection</var>. <syntaxhighlight lang="prolog"> collection_to_set( Collection, Set ) :- part( known_true, Collection, KnownTrue ), part( not_heavy, Collection, NotHeavy ), part( not_light, Collection, NotLight ), part( untested, Collection, Untested ), ord_union( [KnownTrue,NotHeavy,NotLight,Untested], Set ). </syntaxhighlight> ==== information_content( +Counts, ?Content ) ==== holds when <var>Content</var> is the cumulative negative entropy of <var>Counts</var>. A reduction in entropy equates to a gain in information. <syntaxhighlight lang="prolog"> information_content( Counts, Content ) :- information_content1( Counts, 0, Content ). information_content1( [], Content, Content ). information_content1( [Count|Counts], Content0, Content ):- coins_entropy( Count, Entropy ), Content1 is Content0-Entropy, information_content1( Counts, Content1, Content ). </syntaxhighlight> ==== coins_entropy( ?N, ?Entropy ) ==== holds when <var>Entropy</var> estimates the entropy of a sample of <var>N</var> coins. <var>Entropy</var> = P log₂(1/P), where P = <var>N</var>/12. <syntaxhighlight lang="prolog"> coins_entropy( 0, 0.0 ). coins_entropy( 1, 0.2987 ). coins_entropy( 2, 0.4308 ). coins_entropy( 3, 0.5 ). coins_entropy( 4, 0.5283 ). coins_entropy( 5, 0.5263 ). coins_entropy( 6, 0.5 ). coins_entropy( 7, 0.4536 ). coins_entropy( 8, 0.39 ). coins_entropy( 9, 0.3113 ). coins_entropy( 10, 0.2192 ). coins_entropy( 11, 0.1151 ). coins_entropy( 12, 0.0 ). </syntaxhighlight> ====select_coins( +Part, +Coins, ?Sample, ?Residue, ?N )==== holds when <var>N</var> coins from <var>Part</var> of <var>Coins</var> form <var>Part</var> of <var>Sample</var>, with the remainder forming <var>Part</var> of <var>Residue</var>. <syntaxhighlight lang="prolog"> select_coins( Part, Coins, Sample, Residue, Count ) :- part( Part, Coins, Input ), part( Part, Sample, Selection ), part( Part, Residue, Remainder ), select_n( Count, Input, Selection, Remainder ). select_n( 0, In, [], In ). select_n( 1, [A|Suffix], [A], Suffix ). select_n( 2, [A,B|Suffix], [A,B], Suffix ). select_n( 3, [A,B,C|Suffix], [A,B,C], Suffix ). select_n( 4, [A,B,C,D|Suffix], [A,B,C,D], Suffix ). select_n( 5, [A,B,C,D,E|Suffix], [A,B,C,D,E], Suffix ). select_n( 6, [A,B,C,D,E,F|Suffix], [A,B,C,D,E,F], Suffix ). </syntaxhighlight> Load a small library of [[Puzzle Utilities]]. <syntaxhighlight lang="prolog"> :- ensure_loaded( misc ). </syntaxhighlight> Use the ordsets library. <syntaxhighlight lang="prolog"> :- use_module( library(ordsets), [ord_union/2,ord_union/3] ). </syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/download/counterfeit.txt here]. ==Output== <div class="result"> Number the coins 1..12 BEGIN Put the coins numbered 1, 2, 3 and 4 on the left-hand pan Put the coins numbered 5, 6, 7 and 8 on the right-hand pan Leaving the coins numbered 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 1, 2, 5 and 6 on the left-hand pan Put the coins numbered 3, 7, 9 and 10 on the right-hand pan Leaving the coins numbered 4, 8, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 1 and 7 on the left-hand pan Put the coins numbered 3 and 4 on the right-hand pan Leaving the coins numbered 2, 5, 6, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 1, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 7, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 2, which is light END If the left-hand pan is heavier then: BEGIN Put the coins numbered 3 and 5 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 4, 6, 7, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 3, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 5, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 6, which is heavy END If the pans balance then: BEGIN Put the coins numbered 4 and 8 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 3, 5, 6, 7, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 4, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 8, which is heavy END END If the left-hand pan is heavier then: BEGIN Put the coins numbered 1, 2, 5 and 6 on the left-hand pan Put the coins numbered 3, 7, 9 and 10 on the right-hand pan Leaving the coins numbered 4, 8, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 3 and 5 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 4, 6, 7, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 5, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 3, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 6, which is light END If the left-hand pan is heavier then: BEGIN Put the coins numbered 1 and 7 on the left-hand pan Put the coins numbered 3 and 4 on the right-hand pan Leaving the coins numbered 2, 5, 6, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 7, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 1, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 2, which is heavy END If the pans balance then: BEGIN Put the coins numbered 4 and 8 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 3, 5, 6, 7, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 8, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 4, which is heavy END END If the pans balance then: BEGIN Put the coins numbered 9, 10 and 11 on the left-hand pan Put the coins numbered 1, 2 and 3 on the right-hand pan Leaving the coins numbered 4, 5, 6, 7, 8 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coin numbered 9 on the left-hand pan Put the coin numbered 10 on the right-hand pan Leaving the coins numbered 1, 2, 3, 4, 5, 6, 7, 8, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 9, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 10, which is light If the pans balance then: Conclude that the counterfeit coin is number 11, which is light END If the left-hand pan is heavier then: BEGIN Put the coin numbered 9 on the left-hand pan Put the coin numbered 10 on the right-hand pan Leaving the coins numbered 1, 2, 3, 4, 5, 6, 7, 8, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 10, which is heavy If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 9, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 11, which is heavy END If the pans balance then: BEGIN Put the coin numbered 12 on the left-hand pan Put the coin numbered 1 on the right-hand pan Leaving the coins numbered 2, 3, 4, 5, 6, 7, 8, 9, 10 and 11 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 12, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 12, which is heavy END END END </div> ---- b63688bc0886a32b189c21827d28ab6f996528b6 93 90 2015-04-24T19:49:48Z John 2 /* select_coins( +Part, +Coins, ?Sample, ?Residue, ?N ) */ wikitext text/x-wiki __NOTOC__ ==Problem Definition== We are given 12 apparently identical coins - one of which is counterfeit. We know that the counterfeit has a different weight from the others, but we don't know if it's heavier or lighter. ===Task:=== Devise a procedure to identify any counterfeit coin using a balance to take up to three comparative weighings. ==Strategy== The information from three suitable weighings will make all but one of the 'coins', which are untested initially, 'known true'. There are three alternative deductions that make a coin 'known true': * if it is 'not heavy' and 'not light' - having been on both the comparatively lighter and heavier sides of imbalances; * if it was excluded from an imbalance; * if it was included in a balanced weighing. After three weighings there must be exactly one coin, the counterfeit, which is not 'true'. If the counterfeit is not true and 'not heavy' we deduce that it must be light. If it is not true and 'not light', it must be heavy. We use a 'generate-and-test' method as follows: * Create the set of all possible 'counterfeits': 12 coins &times; 2 weights ; * Devise a procedure that can identify the first counterfeit coin; * Show that the same procedure works for every other counterfeit. ==Entry Point== ====go==== is the entry point. It solves the puzzle, then uses a DCG to pretty-print the resulting procedure. <syntaxhighlight lang="prolog"> go :- coins_puzzle( Procedure ), phrase( general_explanation( Procedure ), Chars ), put_chars( Chars ). </syntaxhighlight> ====coins_puzzle( ?Procedure )==== generates the set of all possible 'counterfeits' and finds (or proves) that <var>Procedure</var> can identify them all. <syntaxhighlight lang="prolog"> coins_puzzle( Procedure ) :- coins( Coins ), counterfeit( Counterfeit, Coin, Weight ), findall( Counterfeit, (member(Coin,Coins), counterfeit_weight(Weight)), Counterfeits ), coins_puzzle_solution( Counterfeits, Procedure ). coins_puzzle_solution( [], _Procedure ). coins_puzzle_solution( [Counterfeit|Counterfeits], Procedure ) :- solve_coins( Counterfeit, Procedure ), coins_puzzle_solution( Counterfeits, Procedure ). </syntaxhighlight> A procedure is either 'done', identifying a particular coin and whether it is 'heavy' or 'light'; or it is a 'step'. A step defines the coins to be placed on the <var>Left</var> and <var>Right</var> pans, with the residue remaining on the <var>Table</var>, and three <var>Branches</var>, one of which will be chosen depending on the outcome of the weighing. <syntaxhighlight lang="prolog"> step( step(Left,Right,Table,Branches), Left, Right, Table, Branches). </syntaxhighlight> The <var>Branches</var> are three procedures equating to: * > (left pan heavier), * < (right pan heavier) and * <nowiki>= (pans balance).</nowiki> <syntaxhighlight lang="prolog"> branch( >, branches(_Equal, GT, _LT), GT ). branch( <, branches(_Equal, _GT, LT), LT ). branch( =, branches(Equal, _GT, _LT), Equal ). </syntaxhighlight> The counterfeit is defined by its number and whether it is heavy or light. <syntaxhighlight lang="prolog"> counterfeit( counterfeit(Coin, HeavyOrLight), Coin, HeavyOrLight ). coins( [1,2,3,4,5,6,7,8,9,10,11,12] ). counterfeit_weight( heavy ). counterfeit_weight( light ). </syntaxhighlight> A 'coin collection' comprises four 'parts' (subsets): the <code>known_true</code>, <code>not_heavy</code>, <code>not_light</code> and <code>untested</code> sets of coins. <syntaxhighlight lang="prolog"> part( known_true, collection(Coins,_,_,_), Coins ). part( not_heavy, collection(_,Coins,_,_), Coins ). part( not_light, collection(_,_,Coins,_), Coins ). part( untested, collection(_,_,_,Coins), Coins ). </syntaxhighlight> ==Solution== ====solve_coins( +Counterfeit, ?Procedure )==== holds when <var>Procedure</var> can correctly identify the <var>Counterfeit</var> coin. Beginning with a 'start' collection, in which all the coins are untested, the <var>Procedure</var> comprises three 'steps'. For each step a 'weighing' is made and a 'branch' is made in the <var>Procedure</var>, depending on the result of the weighing. After three steps, the <var>Procedure</var> must have reached the 'end' condition. Finally, an assertion (redundant test) ensures that the <var>Procedure</var> has found the correct end condition. <syntaxhighlight lang="prolog"> solve_coins( Counterfeit, Procedure ) :- start( Coins0 ), assay( Counterfeit, Coins0, Procedure, Branch1, Coins1 ), assay( Counterfeit, Coins1, Branch1, Branch2, Coins2 ), assay( Counterfeit, Coins2, Branch2, done(Coin, HeavyOrLight), Coins3 ), end( Coins3, Coin, HeavyOrLight ), counterfeit( Counterfeit, Coin, HeavyOrLight ). start( Coins ) :- coins( Untested ), part( untested, Coins, Untested ), part( not_heavy, Coins, [] ), part( not_light, Coins, [] ), part( known_true, Coins, [] ). end( Coins, Coin, HeavyOrLight ) :- part( untested, Coins, [] ), part( not_heavy, Coins, Light ), part( not_light, Coins, Heavy ), end_result( Heavy, Light, Coin, HeavyOrLight ). end_result( [Coin], [], Coin, heavy ). end_result( [], [Coin], Coin, light ). </syntaxhighlight> === Simulating the weighing process === ====assay( +Counterfeit, +Coins0, ?Step, ?Branch, ?Coins1 )==== holds when the appropriate <var>Branch</var> from <var>Step</var> is chosen by comparing the weights of two coin collections taken from the full set of coins: <var>Coins0</var>. <var>Coins1</var> is the full set of coins, updated with the inferences drawn from the weighing. <var>Counterfeit</var> is used to determine the result of the weighing. This predicate applies the critical insight into the solution of this puzzle: we have 24 (12 &times; 2) possible inputs to the procedure, with only 27 (3 &times; 3 &times; 3) possible outcomes from the weighings. Therefore, it is clear that each weighing must have a very high 'information content'. Choosing which weighing to make by estimating the available information content makes the problem tractable. <syntaxhighlight lang="prolog"> assay( Counterfeit, Coins0, Step, Branch, Coins ) :- WeighingDatum = weighing_data(InfoContent, Left, Right, Table), step( Step, Left, Right, Table, Branches ), findall( WeighingDatum, valid_partition( Coins0, InfoContent, Left, Right, Table ), WeighingData ), sort( WeighingData, OrderedWeighingData ), member( WeighingDatum, OrderedWeighingData ), balance( Left, Right, Counterfeit, Result ), draw_inferences( Result, Left, Right, Table, Coins ), branch( Result, Branches, Branch ). </syntaxhighlight> ====balance( +Left, +Right, +Counterfeit, ?Result )==== holds when <var>Result</var> simulates the outcome of testing the coin collections <var>Left</var> and <var>Right</var> with a balance, where either may contain the <var>Counterfeit</var> coin. <syntaxhighlight lang="prolog"> balance( Left, Right, Counterfeit, Result ):- counterfeit( Counterfeit, Coin, Weight ), ( contains_coin( Left, Coin ) -> balance_result( Weight, normal, Result ) ; contains_coin( Right, Coin ) -> balance_result( normal, Weight, Result ) ; otherwise -> Result = '=' ). balance_result( light, normal, < ). balance_result( heavy, normal, > ). balance_result( normal, heavy, < ). balance_result( normal, light, > ). </syntaxhighlight> ===Choosing which coins to weigh=== ====valid_partition( +Coins, ?Content, ?Left, ?Right, ?Table )==== holds when <var>Coins</var> can be partitioned into three collections: <var>Left</var> side, <var>Right</var> side and <var>Table</var>; with the 'information content' of the partition given by <var>Content</var>. The definition of a 'valid partition' ensures that: * <var>Left</var> and <var>Right</var> must have the same number of coins (at least one); * <var>Left</var> cannot contain any known 'true' coins, because adding true coins to both sides creates redundant comparisons. A 'checksum' is used to ensure that only one member of each pair of symmetrical solutions can be generated. <syntaxhighlight lang="prolog"> valid_partition( Coins, Content, Left, Right, Table ):- part( known_true, Left, [] ), selection( Coins, Left, Coins1, Count, LeftChecksum, LeftInfo ), Count >= 1, selection( Coins1, Right, Table, Count, RightChecksum, RightInfo ), LeftChecksum =< RightChecksum, % Checksum to prevent symmetrical solutions table_information( Table, TableInfo ), sum( [LeftInfo,RightInfo,TableInfo], Content ). </syntaxhighlight> ====selection( +Coins, ?Sample, ?Residue, ?Count, ?Checksum, ?Content )==== holds when <var>Coins</var> is partitioned into two collections: <var>Sample</var> and <var>Residue</var>. <var>Count</var> is the number of coins in <var>Sample</var>. <var>Checksum</var> is a fingerprint for the mixture of coins in <var>Sample</var>, which has estimated information <var>Content</var>. <syntaxhighlight lang="prolog"> selection( Coins, Sample, Residue, Count, Checksum, Content ) :- select_coins( not_heavy, Coins, Sample, Residue, Count1 ), select_coins( not_light, Coins, Sample, Residue, Count2 ), select_coins( untested, Coins, Sample, Residue, Count3 ), select_coins( known_true, Coins, Sample, Residue, Count4 ), Count is Count1+Count2+Count3+Count4, Count =< 6, Checksum is Count1+(7*Count2)+(43*Count3)+(259*Count4), information_content( [Count1,Count2,Count3,Count4], Content ). </syntaxhighlight> ====table_information( +Coins, ?Content )==== holds when <var>Coins</var> has 'information content' <var>Content</var>. <syntaxhighlight lang="prolog"> table_information( Coins, Content ) :- count_coins( not_heavy, Coins, Count1 ), count_coins( not_light, Coins, Count2 ), count_coins( untested, Coins, Count3 ), count_coins( known_true, Coins, Count4 ), information_content( [Count1,Count2,Count3,Count4], Content ). count_coins( Part, Coins, Count ) :- part( Part, Coins, Selection ), length( Selection, Count ). </syntaxhighlight> === Updating what is known about the coins === ====draw_inferences( +Result, +Left, +Right, +Table, ?Coins )==== holds when <var>Result</var> is one of: * > (imbalance - left pan heavier), * < (imbalance - right pan heavier) or * <nowiki>=</nowiki> (pans balanced) from taking a weighing with the coin collections: <var>Left</var>, <var>Right</var> and <var>Table</var>. <var>Coins</var> is derived from this information using the following rules: * If the pans are unbalanced then only the previously untested or not_heavy coins on the lighter side of the balance are now not_heavy. Similarly, only the previously untested or not_light coins on the heavier side of the balance are now not_light. All the coins on the table are now known_true. * If the pans balance then all the coins weighed are known_true, with the coins on the <var>Table</var> left in their prior states. <syntaxhighlight lang="prolog"> draw_inferences( <, Left, Right, Table, Coins ) :- imbalance_inferences( Left, Right, Table, Coins ). draw_inferences( >, Left, Right, Table, Coins ) :- imbalance_inferences( Right, Left, Table, Coins ). draw_inferences( =, Left, Right, Table, Coins ) :- becomes( [all(Left),known_true(Table),all(Right)], known_true( Coins ) ), becomes( untested(Table), untested(Coins) ), becomes( not_heavy(Table), not_heavy(Coins) ), becomes( not_light(Table), not_light(Coins) ). </syntaxhighlight> ====imbalance_inferences( +Lighter, +Heavier, +Table, ?Coins )==== holds when: * All untested or not_heavy coins in <var>Lighter</var> are not_heavy in <var>Coins</var>; * All untested or not_light coins in <var>Heavier</var> are not_light in <var>Coins</var>; * All coins in <var>Table</var> are known_true in <var>Coins</var>; There are no untested coins in <var>Coins</var>. <syntaxhighlight lang="prolog"> imbalance_inferences( Lighter, Heavier, Table, Coins ) :- becomes( [untested(Lighter),not_heavy(Lighter)], not_heavy(Coins) ), becomes( [untested(Heavier),not_light(Heavier)], not_light(Coins) ), becomes( [ known_true(Lighter), not_light(Lighter), known_true(Heavier), not_heavy(Heavier), all(Table) ], known_true(Coins) ), part( untested, Coins, [] ). </syntaxhighlight> ====becomes( +CollectionA, ?CollectionB )==== <var>CollectionA</var> becomes (part) <var>CollectionB</var> when <var>CollectionB</var> comprises the same coins as <var>CollectionA</var>. <syntaxhighlight lang="prolog"> becomes( CollectionA, CollectionB ) :- unfolded( CollectionA, Coins ), unfolded( CollectionB, Coins ). </syntaxhighlight> ====unfolded( +Collection, ?Coins )==== holds when (part) <var>Collection</var> comprises <var>Coins</var>. <syntaxhighlight lang="prolog"> unfolded( not_light(Collection), Coins ) :- part( not_light, Collection, Coins ). unfolded( not_heavy(Collection), Coins ) :- part( not_heavy, Collection, Coins ). unfolded( known_true(Collection), Coins ) :- part( known_true, Collection, Coins ). unfolded( untested(Collection), Coins ) :- part( untested, Collection, Coins ). unfolded( all(Collection), Coins ) :- collection_to_set( Collection, Coins ). unfolded( [Item|Items], Coins ) :- unfolded( Item, Value ), unfolded1( Items, Value, Coins ). unfolded1( [], Coins, Coins ). unfolded1( [Item|Items], Value, Coins ) :- unfolded( Item, Value0 ), ord_union( Value0, Value, Value1 ), unfolded1( Items, Value1, Coins ). </syntaxhighlight> ==Definite Clause Grammar== The following DCG represents the method for finding the counterfeit coin as a structured procedure. <syntaxhighlight lang="prolog"> general_explanation( Procedure ) --> "Number the coins 1..12", newline, explanation( Procedure, 0 ). explanation( done(Coin, Weight), N ) --> tab( N ), "Conclude that the counterfeit coin is number ", literal( Coin ), ", which is ", literal( Weight ), newline. explanation( Step, N ) --> {step( Step, Left, Right, Table, Branches )}, tab( N ), "BEGIN", newline, tab( N ), "Put ", literal( Left ), " on the left-hand pan", newline, tab( N ), "Put ", literal( Right ), " on the right-hand pan", newline, tab( N ), "Leaving ", literal( Table ), " on the table", newline, branches_explained( Branches, N ), tab( N ), "END", newline. branches_explained( Branches, N ) --> next_step_explained( <, Branches, N ), next_step_explained( >, Branches, N ), next_step_explained( =, Branches, N ). next_step_explained( Result, Branch, N ) --> {branch( Result, Branch, Step )}, ( {var(Step)} -> "" | {nonvar(Step)} -> tab( N ), "If the ", literal( Result ), " then:", newline, explanation( Step, s(N) ) ). literal( 0 ) --> "0". literal( 1 ) --> "1". literal( 2 ) --> "2". literal( 3 ) --> "3". literal( 4 ) --> "4". literal( 5 ) --> "5". literal( 6 ) --> "6". literal( 7 ) --> "7". literal( 8 ) --> "8". literal( 9 ) --> "9". literal( 10 ) --> "10". literal( 11 ) --> "11". literal( 12 ) --> "12". literal( true ) --> "true". literal( heavy ) --> "heavy". literal( light ) --> "light". literal( = ) --> "pans balance". literal( < ) --> "right-hand pan is heavier". literal( > ) --> "left-hand pan is heavier". literal( Collection ) --> {collection_to_set( Collection , [H|T] )}, literal_set( T, H ). literal_set( [], Number ) --> "the coin numbered ", literal( Number ). literal_set( [H|T], Number ) --> "the coins numbered ", literal( Number ), literal_set1( T, H ). literal_set1( [], Number ) --> " and ", literal( Number ). literal_set1( [H|T], Number ) --> ", ", literal( Number ), literal_set1( T, H ). tab( 0 ) --> "". tab( s(N) ) --> " ", tab( N ). newline --> " ". </syntaxhighlight> ===Utility Predicates=== ====contains_coin( ?Collection, ?Coin )==== holds when <var>Coin</var> is a member of <var>Collection</var>. <syntaxhighlight lang="prolog"> contains_coin( Collection, Coin ) :- part( _Part, Collection, Coins ), member( Coin, Coins ). </syntaxhighlight> ====collection_to_set( +Collection, ?Set )==== holds when <var>Set</var> is the distributed union of the <code>known_true</code>, <code>not_heavy</code>, <code>not_light</code> and <code>untested</code> ordsets comprising <var>Collection</var>. <syntaxhighlight lang="prolog"> collection_to_set( Collection, Set ) :- part( known_true, Collection, KnownTrue ), part( not_heavy, Collection, NotHeavy ), part( not_light, Collection, NotLight ), part( untested, Collection, Untested ), ord_union( [KnownTrue,NotHeavy,NotLight,Untested], Set ). </syntaxhighlight> ==== information_content( +Counts, ?Content ) ==== holds when <var>Content</var> is the cumulative negative entropy of <var>Counts</var>. A reduction in entropy equates to a gain in information. <syntaxhighlight lang="prolog"> information_content( Counts, Content ) :- information_content1( Counts, 0, Content ). information_content1( [], Content, Content ). information_content1( [Count|Counts], Content0, Content ):- coins_entropy( Count, Entropy ), Content1 is Content0-Entropy, information_content1( Counts, Content1, Content ). </syntaxhighlight> ==== coins_entropy( ?N, ?Entropy ) ==== holds when <var>Entropy</var> estimates the entropy of a sample of <var>N</var> coins. <var>Entropy</var> = P log₂(1/P), where P = <var>N</var>/12. <syntaxhighlight lang="prolog"> coins_entropy( 0, 0.0 ). coins_entropy( 1, 0.2987 ). coins_entropy( 2, 0.4308 ). coins_entropy( 3, 0.5 ). coins_entropy( 4, 0.5283 ). coins_entropy( 5, 0.5263 ). coins_entropy( 6, 0.5 ). coins_entropy( 7, 0.4536 ). coins_entropy( 8, 0.39 ). coins_entropy( 9, 0.3113 ). coins_entropy( 10, 0.2192 ). coins_entropy( 11, 0.1151 ). coins_entropy( 12, 0.0 ). </syntaxhighlight> ====select_coins( +Part, +Coins, ?Sample, ?Residue, ?N )==== holds when <var>N</var> coins from <var>Part</var> of <var>Coins</var> form <var>Part</var> of <var>Sample</var>, with the remainder forming <var>Part</var> of <var>Residue</var>. <syntaxhighlight lang="prolog"> select_coins( Part, Coins, Sample, Residue, Count ) :- part( Part, Coins, Input ), part( Part, Sample, Selection ), part( Part, Residue, Remainder ), select_n( Count, Input, Selection, Remainder ). select_n( 0, In, [], In ). select_n( 1, [A|Suffix], [A], Suffix ). select_n( 2, [A,B|Suffix], [A,B], Suffix ). select_n( 3, [A,B,C|Suffix], [A,B,C], Suffix ). select_n( 4, [A,B,C,D|Suffix], [A,B,C,D], Suffix ). select_n( 5, [A,B,C,D,E|Suffix], [A,B,C,D,E], Suffix ). select_n( 6, [A,B,C,D,E,F|Suffix], [A,B,C,D,E,F], Suffix ). </syntaxhighlight> Load a small library of [[Puzzle Utilities]]. <syntaxhighlight lang="prolog"> :- ensure_loaded( misc ). </syntaxhighlight> Use the ordsets library. <syntaxhighlight lang="prolog"> :- use_module( library(ordsets), [ord_union/2,ord_union/3] ). </syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/download/counterfeit.txt here]. ==Output== <div class="result"> Number the coins 1..12 BEGIN Put the coins numbered 1, 2, 3 and 4 on the left-hand pan Put the coins numbered 5, 6, 7 and 8 on the right-hand pan Leaving the coins numbered 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 1, 2, 5 and 6 on the left-hand pan Put the coins numbered 3, 7, 9 and 10 on the right-hand pan Leaving the coins numbered 4, 8, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 1 and 7 on the left-hand pan Put the coins numbered 3 and 4 on the right-hand pan Leaving the coins numbered 2, 5, 6, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 1, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 7, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 2, which is light END If the left-hand pan is heavier then: BEGIN Put the coins numbered 3 and 5 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 4, 6, 7, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 3, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 5, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 6, which is heavy END If the pans balance then: BEGIN Put the coins numbered 4 and 8 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 3, 5, 6, 7, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 4, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 8, which is heavy END END If the left-hand pan is heavier then: BEGIN Put the coins numbered 1, 2, 5 and 6 on the left-hand pan Put the coins numbered 3, 7, 9 and 10 on the right-hand pan Leaving the coins numbered 4, 8, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 3 and 5 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 4, 6, 7, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 5, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 3, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 6, which is light END If the left-hand pan is heavier then: BEGIN Put the coins numbered 1 and 7 on the left-hand pan Put the coins numbered 3 and 4 on the right-hand pan Leaving the coins numbered 2, 5, 6, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 7, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 1, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 2, which is heavy END If the pans balance then: BEGIN Put the coins numbered 4 and 8 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 3, 5, 6, 7, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 8, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 4, which is heavy END END If the pans balance then: BEGIN Put the coins numbered 9, 10 and 11 on the left-hand pan Put the coins numbered 1, 2 and 3 on the right-hand pan Leaving the coins numbered 4, 5, 6, 7, 8 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coin numbered 9 on the left-hand pan Put the coin numbered 10 on the right-hand pan Leaving the coins numbered 1, 2, 3, 4, 5, 6, 7, 8, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 9, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 10, which is light If the pans balance then: Conclude that the counterfeit coin is number 11, which is light END If the left-hand pan is heavier then: BEGIN Put the coin numbered 9 on the left-hand pan Put the coin numbered 10 on the right-hand pan Leaving the coins numbered 1, 2, 3, 4, 5, 6, 7, 8, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 10, which is heavy If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 9, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 11, which is heavy END If the pans balance then: BEGIN Put the coin numbered 12 on the left-hand pan Put the coin numbered 1 on the right-hand pan Leaving the coins numbered 2, 3, 4, 5, 6, 7, 8, 9, 10 and 11 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 12, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 12, which is heavy END END END </div> ---- 06193434b1ed0666b8a390fcf733b7854a59e407 0 10 54 50 2013-11-16T00:08:10Z John 2 /* Constrained Permutations in Prolog */ wikitext text/x-wiki ;Constrained Permutations in Prolog __NOTOC__ Problem posted to [http://groups.google.com/group/comp.lang.prolog/msg/a984ea325e0a4180 comp.lang.prolog] by Daniel Dudley ===Problem Statement=== <blockquote>A university was to hold an examination in 5 subjects: Norwegian, German, English, French and Spanish. In each of these languages there were 4 candidates. The examination room was therefore divided into 20 cells, as shown in the figure below (view this in a fixed font): <pre> X X X X X X X X X X X X X X X X X X X X</pre> The university's administration wanted to secure themselves against cheating. Candidates in the same language were to be completely isolated from each other - so much so that their cells were not to coincide even at the corners. A young lecturer was given the job of finding a solution to the problem, which he did, and justly received a pat on the back from the dean. Now it just so happens that the dean is an ardent prolog programmer in his spare time (how else could he make dean?) and, realizing that there could be several solutions to the problem, used his skills to find all solutions. Can you do the same? </blockquote> ===Note=== &quot;Several solutions&quot; doesn't really cover it! Assuming that by 'a solution' we mean finding a mapping between candidates and cells, then, having found one such solution, we can find 955,514,879 other members of its solution &quot;family&quot; quite easily, through: * ''candidate permutation'': There are (4!)⁵ permutations of the candidates within the cells allocated to their subjects; * ''subject permutation'': we can multiply the 'candidate permutations' by the 5! permutations of the subjects allocated to particular sets of cells. This means that the total number of solutions is 955514880 &times; D where D is the number of solution families i.e. solutions that cannot be derived from each other by candidate or subject permutation. Finding [[#Result|D]] is the more interesting problem solved by this program. ====nut1( ?Solutions )==== <var>Solutions</var> is the number of distinct solutions to the subject/cell allocation problem for any five different subjects. <syntaxhighlight lang="prolog">nut1( Solutions ) :- Norwegian = 1, German = 2, English = 3, French = 4, Spanish = 5, candidates( [Norwegian,German,English,French,Spanish], Candidates ), matrix( Cells ), count_solutions( allocate(Cells,Candidates), Solutions ).</syntaxhighlight> ====allocate( +Cells, +Candidates )==== holds when each cell in <var>Cells</var> holds a candidate from <var>Candidates</var>. <syntaxhighlight lang="prolog">allocate( Cells, Candidates ) :- allocation( Cells, 1, Candidates ).</syntaxhighlight> ====allocation( +Cells, +NextSubject, +Subjects )==== holds when <var>Cells</var> is a representation of a distinct solution to the subject/cell allocation problem. <var>NextSubject</var> is the highest subject that can be allocated next, while <var>Subjects</var> is the list of subjects needing allocation to <var>Cells</var>. Each subject is represented by a list, in which each occurrence of the subject number represents a candidate. We guarantee distinct solutions by ensuring that the allocation is made on the following basis: * For each subject: the location of the N+1th candidate must be a successor of the location of the Nth candidate - to eliminate 'candidate permutations'. * The location of the first candidate of the N+1th subject must be a successor of the location of the first candidate of the Nth subject - to eliminate 'subject permutations'. Operationally, at each step we select a candidate for a cell and constrain all the cell's adjacent successors to have different subject(s) from it. <syntaxhighlight lang="prolog">allocation( [], _Next, [] ). allocation( [Cell|Cells], Next, Subjects ) :- allocate_candidate( Subjects, Next, Candidate, Subjects1, Next1 ), cell( Candidate, Cell ), adjacent_successors( Cell, AdjacentSuccessors ), blocked( AdjacentSuccessors, Candidate ), allocation( Cells, Next1, Subjects1 ).</syntaxhighlight> ====allocate_candidate( +Subjects, +Next, ?Candidate, ?Subjects1, ?Next1 )==== holds when <var>Candidate</var> is taken from <var>Subjects</var> leaving <var>Subjects1</var>. <var>Candidate</var> is represented by a subject number <code>=<</code> <var>Next</var>. <var>Next1</var> is the highest subject that can be allocated to the next cell, ensuring that the first candidate for each subject is allocated in order. <syntaxhighlight lang="prolog">allocate_candidate( [Subject|Subjects], Next, Candidate, Subjects1, Next1 ) :- Subject = [Candidate|Candidates], Candidate =< Next, Next1 is max(Candidate+1,Next), residual_candidates( Candidates, Subjects, Subjects1 ). allocate_candidate( [Subject|Subjects], Next, Candidate, [Subject|Subjects1], Next1 ) :- Subject = [Candidate0|_Candidates], Candidate0 < Next, allocate_candidate( Subjects, Next, Candidate, Subjects1, Next1 ). residual_candidates( [], Subjects, Subjects ). residual_candidates( Candidates, Subjects, [Candidates|Subjects] ) :- Candidates = [_|_].</syntaxhighlight> ====matrix( ?Matrix )==== holds when <var>Matrix</var> is a list of 'cells' ordered by their (x,y) coordinates. Each 'cell' is described by 5 binary digits, which indicate the subject assigned to it, and the set of successors of the cell that are adjacent to it. <syntaxhighlight lang="prolog">matrix( Matrix ) :- layout( Layout ), matrix1( Layout, _Index, Matrix ). matrix1( [], _Index, [] ). matrix1( [(Row, Column)|Layout], Index, [Cell|Matrix] ) :- location_cell( Row, Column, Index, Cell ), findall( (Row1, Column1), ( successor( (Row, Column), (Row1, Column1) ), adjacent(Row, Row1), adjacent(Column, Column1) ), AdjacentSuccessorLocations ), location_cells( AdjacentSuccessorLocations, Index, AdjacentSuccessors ), adjacent_successors( Cell, AdjacentSuccessors ), matrix1( Layout, Index, Matrix ).</syntaxhighlight> ====cell( ?Subject, ?Cell )==== holds when <var>Cell</var> is the cell representation for <var>Subject</var>. <syntaxhighlight lang="prolog">cell( 1, cell(1,0,0,0,0,_) ). cell( 2, cell(0,1,0,0,0,_) ). cell( 3, cell(0,0,1,0,0,_) ). cell( 4, cell(0,0,0,1,0,_) ). cell( 5, cell(0,0,0,0,1,_) ).</syntaxhighlight> ====block( ?Subject, ?Block )==== holds when <var>Block</var> is a cell representation that is incompatible with <var>Subject</var>. <syntaxhighlight lang="prolog">block( 1, cell(0,_,_,_,_,_) ). block( 2, cell(_,0,_,_,_,_) ). block( 3, cell(_,_,0,_,_,_) ). block( 4, cell(_,_,_,0,_,_) ). block( 5, cell(_,_,_,_,0,_) ).</syntaxhighlight> ====adjacent_successors( ?Cell, ?AdjacentSuccesors )==== holds when <var>AdjacentSuccesors</var> is the set of successors of <var>Cell</var> that are adjacent to it. <syntaxhighlight lang="prolog">adjacent_successors( cell(_,_,_,_,_,AdjacentSuccesors), AdjacentSuccesors ).</syntaxhighlight> ====blocked( +Blocked, ?Subject )==== holds when all the cells in <var>Blocked</var> are incompatible with <var>Subject</var>. <syntaxhighlight lang="prolog">blocked( [], _Subject ). blocked( [Cell|Blocked], Subject ) :- block( Subject, Cell ), blocked( Blocked, Subject ).</syntaxhighlight> ====adjacent( +Coordinate0, ?Coordinate1 )==== holds when <var>Coordinate0</var> and <var>Coordinate1</var> are the same or differ by 1. <syntaxhighlight lang="prolog">adjacent( N, N ). adjacent( N0, N1 ) :- N1 is N0 + 1. adjacent( N0, N1 ) :- N1 is N0 - 1.</syntaxhighlight> ====location_cells( ?Locations, ?Index, ?Cells )==== holds when <var>Index</var> is a 6 &times; 6 array, <var>Locations</var> is a list of (Row,Column) pairs and <var>Cells</var> is the list of matching cells dereferenced from <var>Index</var>. <syntaxhighlight lang="prolog">location_cells( [], _Index, [] ). location_cells( [(Row, Column)|Locs], Index, [Cell|Cells] ) :- location_cell( Row, Column, Index, Cell ), location_cells( Locs, Index, Cells ).</syntaxhighlight> ====location_cell( ?Row, ?Column, ?Index, ?Cell )==== holds when <var>Index</var> is a 6 &times; 6 array with <var>Cell</var> at location (<var>Row</var>,<var>Column</var>). <syntaxhighlight lang="prolog">location_cell( Row, Column, Index, Cell ) :- select_nth( Row, Index, IndexRow ), select_nth( Column, IndexRow, Cell ).</syntaxhighlight> ====select_nth( ?N, ?Array, ?Element )==== holds when <var>Element</var> is the <var>N</var>th element of <var>Array</var>. <syntaxhighlight lang="prolog">select_nth( 1, array_6(A,_B,_C,_D,_E,_F), A ). select_nth( 2, array_6(_A,B,_C,_D,_E,_F), B ). select_nth( 3, array_6(_A,_B,C,_D,_E,_F), C ). select_nth( 4, array_6(_A,_B,_C,D,_E,_F), D ). select_nth( 5, array_6(_A,_B,_C,_D,E,_F), E ). select_nth( 6, array_6(_A,_B,_C,_D,_E,F), F ).</syntaxhighlight> ====successor( ?Coordinates0, ?Coordinates1 )==== holds when <var>Coordinates0</var> and <var>Coordinates1</var> are valid cell positions and <var>Coordinates0</var> &lt;<var>Coordinates1</var>. <syntaxhighlight lang="prolog">successor( Coordinates0, Coordinates1 ) :- layout( Layout ), append( _Prefix, [Coordinates0|Successors], Layout ), member( Coordinates1, Successors ).</syntaxhighlight> ====candidates( ?Subjects, ?Candidates )==== holds when there are 4 <var>Candidates</var> for each subject in <var>Subjects</var>. <syntaxhighlight lang="prolog">candidates( [], [] ). candidates( [Subj|Subjects], [[Subj,Subj,Subj,Subj]|Candidates] ) :- candidates( Subjects, Candidates ).</syntaxhighlight> ====layout( ?Layout )==== holds when <var>Layout</var> is the sequence of all (x,y) co-ordinates of valid 'cells'. <syntaxhighlight lang="prolog">layout( [ (1,2), (2,2),(2,3),(2,4),(2,5),(2,6), (3,2),(3,3),(3,4),(3,5), (4,2),(4,3),(4,4),(4,5), (5,1),(5,2),(5,3),(5,4),(5,5), (6,5) ] ).</syntaxhighlight> Load a small library of [[Puzzle Utilities]]. <syntaxhighlight lang="prolog">:- ensure_loaded( misc ).</syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/download/nut1.txt here]. === Result === This program reports '''29870''' solutions. 81b82d7b543b452d2e0dc9c814fc447d2d5c193f 55 54 2013-11-16T00:09:02Z John 2 wikitext text/x-wiki ;Constrained Permutations in Prolog __NOTOC__ Problem posted to [http://groups.google.com/group/comp.lang.prolog/msg/a984ea325e0a4180 comp.lang.prolog] by Daniel Dudley ===Problem Statement=== <blockquote>A university was to hold an examination in 5 subjects: Norwegian, German, English, French and Spanish. In each of these languages there were 4 candidates. The examination room was therefore divided into 20 cells, as shown in the figure below (view this in a fixed font): <pre> X X X X X X X X X X X X X X X X X X X X</pre> The university's administration wanted to secure themselves against cheating. Candidates in the same language were to be completely isolated from each other - so much so that their cells were not to coincide even at the corners. A young lecturer was given the job of finding a solution to the problem, which he did, and justly received a pat on the back from the dean. Now it just so happens that the dean is an ardent prolog programmer in his spare time (how else could he make dean?) and, realizing that there could be several solutions to the problem, used his skills to find all solutions. Can you do the same? </blockquote> ===Note=== &quot;Several solutions&quot; doesn't really cover it! Assuming that by 'a solution' we mean finding a mapping between candidates and cells, then, having found one such solution, we can find 955,514,879 other members of its solution &quot;family&quot; quite easily, through: * ''candidate permutation'': There are (4!)⁵ permutations of the candidates within the cells allocated to their subjects; * ''subject permutation'': we can multiply the 'candidate permutations' by the 5! permutations of the subjects allocated to particular sets of cells. This means that the total number of solutions is 955514880 &times; D where D is the number of solution families i.e. solutions that cannot be derived from each other by candidate or subject permutation. Finding [[#Result|D]] is the more interesting problem solved by this program. ====nut1( ?Solutions )==== <var>Solutions</var> is the number of distinct solutions to the subject/cell allocation problem for any five different subjects. <syntaxhighlight lang="prolog">nut1( Solutions ) :- Norwegian = 1, German = 2, English = 3, French = 4, Spanish = 5, candidates( [Norwegian,German,English,French,Spanish], Candidates ), matrix( Cells ), count_solutions( allocate(Cells,Candidates), Solutions ).</syntaxhighlight> ====allocate( +Cells, +Candidates )==== holds when each cell in <var>Cells</var> holds a candidate from <var>Candidates</var>. <syntaxhighlight lang="prolog">allocate( Cells, Candidates ) :- allocation( Cells, 1, Candidates ).</syntaxhighlight> ====allocation( +Cells, +NextSubject, +Subjects )==== holds when <var>Cells</var> is a representation of a distinct solution to the subject/cell allocation problem. <var>NextSubject</var> is the highest subject that can be allocated next, while <var>Subjects</var> is the list of subjects needing allocation to <var>Cells</var>. Each subject is represented by a list, in which each occurrence of the subject number represents a candidate. We guarantee distinct solutions by ensuring that the allocation is made on the following basis: * For each subject: the location of the N+1th candidate must be a successor of the location of the Nth candidate - to eliminate 'candidate permutations'. * The location of the first candidate of the N+1th subject must be a successor of the location of the first candidate of the Nth subject - to eliminate 'subject permutations'. Operationally, at each step we select a candidate for a cell and constrain all the cell's adjacent successors to have different subject(s) from it. <syntaxhighlight lang="prolog">allocation( [], _Next, [] ). allocation( [Cell|Cells], Next, Subjects ) :- allocate_candidate( Subjects, Next, Candidate, Subjects1, Next1 ), cell( Candidate, Cell ), adjacent_successors( Cell, AdjacentSuccessors ), blocked( AdjacentSuccessors, Candidate ), allocation( Cells, Next1, Subjects1 ).</syntaxhighlight> ====allocate_candidate( +Subjects, +Next, ?Candidate, ?Subjects1, ?Next1 )==== holds when <var>Candidate</var> is taken from <var>Subjects</var> leaving <var>Subjects1</var>. <var>Candidate</var> is represented by a subject number <code>=<</code> <var>Next</var>. <var>Next1</var> is the highest subject that can be allocated to the next cell, ensuring that the first candidate for each subject is allocated in order. <syntaxhighlight lang="prolog">allocate_candidate( [Subject|Subjects], Next, Candidate, Subjects1, Next1 ) :- Subject = [Candidate|Candidates], Candidate =< Next, Next1 is max(Candidate+1,Next), residual_candidates( Candidates, Subjects, Subjects1 ). allocate_candidate( [Subject|Subjects], Next, Candidate, [Subject|Subjects1], Next1 ) :- Subject = [Candidate0|_Candidates], Candidate0 < Next, allocate_candidate( Subjects, Next, Candidate, Subjects1, Next1 ). residual_candidates( [], Subjects, Subjects ). residual_candidates( Candidates, Subjects, [Candidates|Subjects] ) :- Candidates = [_|_].</syntaxhighlight> ====matrix( ?Matrix )==== holds when <var>Matrix</var> is a list of 'cells' ordered by their (x,y) coordinates. Each 'cell' is described by 5 binary digits, which indicate the subject assigned to it, and the set of successors of the cell that are adjacent to it. <syntaxhighlight lang="prolog">matrix( Matrix ) :- layout( Layout ), matrix1( Layout, _Index, Matrix ). matrix1( [], _Index, [] ). matrix1( [(Row, Column)|Layout], Index, [Cell|Matrix] ) :- location_cell( Row, Column, Index, Cell ), findall( (Row1, Column1), ( successor( (Row, Column), (Row1, Column1) ), adjacent(Row, Row1), adjacent(Column, Column1) ), AdjacentSuccessorLocations ), location_cells( AdjacentSuccessorLocations, Index, AdjacentSuccessors ), adjacent_successors( Cell, AdjacentSuccessors ), matrix1( Layout, Index, Matrix ).</syntaxhighlight> ====cell( ?Subject, ?Cell )==== holds when <var>Cell</var> is the cell representation for <var>Subject</var>. <syntaxhighlight lang="prolog">cell( 1, cell(1,0,0,0,0,_) ). cell( 2, cell(0,1,0,0,0,_) ). cell( 3, cell(0,0,1,0,0,_) ). cell( 4, cell(0,0,0,1,0,_) ). cell( 5, cell(0,0,0,0,1,_) ).</syntaxhighlight> ====block( ?Subject, ?Block )==== holds when <var>Block</var> is a cell representation that is incompatible with <var>Subject</var>. <syntaxhighlight lang="prolog">block( 1, cell(0,_,_,_,_,_) ). block( 2, cell(_,0,_,_,_,_) ). block( 3, cell(_,_,0,_,_,_) ). block( 4, cell(_,_,_,0,_,_) ). block( 5, cell(_,_,_,_,0,_) ).</syntaxhighlight> ====adjacent_successors( ?Cell, ?AdjacentSuccesors )==== holds when <var>AdjacentSuccesors</var> is the set of successors of <var>Cell</var> that are adjacent to it. <syntaxhighlight lang="prolog">adjacent_successors( cell(_,_,_,_,_,AdjacentSuccesors), AdjacentSuccesors ).</syntaxhighlight> ====blocked( +Blocked, ?Subject )==== holds when all the cells in <var>Blocked</var> are incompatible with <var>Subject</var>. <syntaxhighlight lang="prolog">blocked( [], _Subject ). blocked( [Cell|Blocked], Subject ) :- block( Subject, Cell ), blocked( Blocked, Subject ).</syntaxhighlight> ====adjacent( +Coordinate0, ?Coordinate1 )==== holds when <var>Coordinate0</var> and <var>Coordinate1</var> are the same or differ by 1. <syntaxhighlight lang="prolog">adjacent( N, N ). adjacent( N0, N1 ) :- N1 is N0 + 1. adjacent( N0, N1 ) :- N1 is N0 - 1.</syntaxhighlight> ====location_cells( ?Locations, ?Index, ?Cells )==== holds when <var>Index</var> is a 6 &times; 6 array, <var>Locations</var> is a list of (Row,Column) pairs and <var>Cells</var> is the list of matching cells dereferenced from <var>Index</var>. <syntaxhighlight lang="prolog">location_cells( [], _Index, [] ). location_cells( [(Row, Column)|Locs], Index, [Cell|Cells] ) :- location_cell( Row, Column, Index, Cell ), location_cells( Locs, Index, Cells ).</syntaxhighlight> ====location_cell( ?Row, ?Column, ?Index, ?Cell )==== holds when <var>Index</var> is a 6 &times; 6 array with <var>Cell</var> at location (<var>Row</var>,<var>Column</var>). <syntaxhighlight lang="prolog">location_cell( Row, Column, Index, Cell ) :- select_nth( Row, Index, IndexRow ), select_nth( Column, IndexRow, Cell ).</syntaxhighlight> ====select_nth( ?N, ?Array, ?Element )==== holds when <var>Element</var> is the <var>N</var>th element of <var>Array</var>. <syntaxhighlight lang="prolog">select_nth( 1, array_6(A,_B,_C,_D,_E,_F), A ). select_nth( 2, array_6(_A,B,_C,_D,_E,_F), B ). select_nth( 3, array_6(_A,_B,C,_D,_E,_F), C ). select_nth( 4, array_6(_A,_B,_C,D,_E,_F), D ). select_nth( 5, array_6(_A,_B,_C,_D,E,_F), E ). select_nth( 6, array_6(_A,_B,_C,_D,_E,F), F ).</syntaxhighlight> ====successor( ?Coordinates0, ?Coordinates1 )==== holds when <var>Coordinates0</var> and <var>Coordinates1</var> are valid cell positions and <var>Coordinates0</var> &lt;<var>Coordinates1</var>. <syntaxhighlight lang="prolog">successor( Coordinates0, Coordinates1 ) :- layout( Layout ), append( _Prefix, [Coordinates0|Successors], Layout ), member( Coordinates1, Successors ).</syntaxhighlight> ====candidates( ?Subjects, ?Candidates )==== holds when there are 4 <var>Candidates</var> for each subject in <var>Subjects</var>. <syntaxhighlight lang="prolog">candidates( [], [] ). candidates( [Subj|Subjects], [[Subj,Subj,Subj,Subj]|Candidates] ) :- candidates( Subjects, Candidates ).</syntaxhighlight> ====layout( ?Layout )==== holds when <var>Layout</var> is the sequence of all (x,y) co-ordinates of valid 'cells'. <syntaxhighlight lang="prolog">layout( [ (1,2), (2,2),(2,3),(2,4),(2,5),(2,6), (3,2),(3,3),(3,4),(3,5), (4,2),(4,3),(4,4),(4,5), (5,1),(5,2),(5,3),(5,4),(5,5), (6,5) ] ).</syntaxhighlight> Load a small library of [[Puzzle Utilities]]. <syntaxhighlight lang="prolog">:- ensure_loaded( misc ).</syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/download/nut1.txt here]. === Result === This program reports '''29870''' solutions. 5e15385978e8aaeeb909e9e583fd42a0b2a0cb7f 63 55 2013-12-29T16:20:42Z John 2 Use 'le' character. wikitext text/x-wiki ;Constrained Permutations in Prolog __NOTOC__ Problem posted to [http://groups.google.com/group/comp.lang.prolog/msg/a984ea325e0a4180 comp.lang.prolog] by Daniel Dudley ===Problem Statement=== <blockquote>A university was to hold an examination in 5 subjects: Norwegian, German, English, French and Spanish. In each of these languages there were 4 candidates. The examination room was therefore divided into 20 cells, as shown in the figure below (view this in a fixed font): <pre> X X X X X X X X X X X X X X X X X X X X</pre> The university's administration wanted to secure themselves against cheating. Candidates in the same language were to be completely isolated from each other - so much so that their cells were not to coincide even at the corners. A young lecturer was given the job of finding a solution to the problem, which he did, and justly received a pat on the back from the dean. Now it just so happens that the dean is an ardent prolog programmer in his spare time (how else could he make dean?) and, realizing that there could be several solutions to the problem, used his skills to find all solutions. Can you do the same? </blockquote> ===Note=== &quot;Several solutions&quot; doesn't really cover it! Assuming that by 'a solution' we mean finding a mapping between candidates and cells, then, having found one such solution, we can find 955,514,879 other members of its solution &quot;family&quot; quite easily, through: * ''candidate permutation'': There are (4!)⁵ permutations of the candidates within the cells allocated to their subjects; * ''subject permutation'': we can multiply the 'candidate permutations' by the 5! permutations of the subjects allocated to particular sets of cells. This means that the total number of solutions is 955514880 &times; D where D is the number of solution families i.e. solutions that cannot be derived from each other by candidate or subject permutation. Finding [[#Result|D]] is the more interesting problem solved by this program. ====nut1( ?Solutions )==== <var>Solutions</var> is the number of distinct solutions to the subject/cell allocation problem for any five different subjects. <syntaxhighlight lang="prolog">nut1( Solutions ) :- Norwegian = 1, German = 2, English = 3, French = 4, Spanish = 5, candidates( [Norwegian,German,English,French,Spanish], Candidates ), matrix( Cells ), count_solutions( allocate(Cells,Candidates), Solutions ).</syntaxhighlight> ====allocate( +Cells, +Candidates )==== holds when each cell in <var>Cells</var> holds a candidate from <var>Candidates</var>. <syntaxhighlight lang="prolog">allocate( Cells, Candidates ) :- allocation( Cells, 1, Candidates ).</syntaxhighlight> ====allocation( +Cells, +NextSubject, +Subjects )==== holds when <var>Cells</var> is a representation of a distinct solution to the subject/cell allocation problem. <var>NextSubject</var> is the highest subject that can be allocated next, while <var>Subjects</var> is the list of subjects needing allocation to <var>Cells</var>. Each subject is represented by a list, in which each occurrence of the subject number represents a candidate. We guarantee distinct solutions by ensuring that the allocation is made on the following basis: * For each subject: the location of the N+1th candidate must be a successor of the location of the Nth candidate - to eliminate 'candidate permutations'. * The location of the first candidate of the N+1th subject must be a successor of the location of the first candidate of the Nth subject - to eliminate 'subject permutations'. Operationally, at each step we select a candidate for a cell and constrain all the cell's adjacent successors to have different subject(s) from it. <syntaxhighlight lang="prolog">allocation( [], _Next, [] ). allocation( [Cell|Cells], Next, Subjects ) :- allocate_candidate( Subjects, Next, Candidate, Subjects1, Next1 ), cell( Candidate, Cell ), adjacent_successors( Cell, AdjacentSuccessors ), blocked( AdjacentSuccessors, Candidate ), allocation( Cells, Next1, Subjects1 ).</syntaxhighlight> ====allocate_candidate( +Subjects, +Next, ?Candidate, ?Subjects1, ?Next1 )==== holds when <var>Candidate</var> is taken from <var>Subjects</var> leaving <var>Subjects1</var>. <var>Candidate</var> is represented by a subject number &le; <var>Next</var>. <var>Next1</var> is the highest subject that can be allocated to the next cell, ensuring that the first candidate for each subject is allocated in order. <syntaxhighlight lang="prolog">allocate_candidate( [Subject|Subjects], Next, Candidate, Subjects1, Next1 ) :- Subject = [Candidate|Candidates], Candidate =< Next, Next1 is max(Candidate+1,Next), residual_candidates( Candidates, Subjects, Subjects1 ). allocate_candidate( [Subject|Subjects], Next, Candidate, [Subject|Subjects1], Next1 ) :- Subject = [Candidate0|_Candidates], Candidate0 < Next, allocate_candidate( Subjects, Next, Candidate, Subjects1, Next1 ). residual_candidates( [], Subjects, Subjects ). residual_candidates( Candidates, Subjects, [Candidates|Subjects] ) :- Candidates = [_|_].</syntaxhighlight> ====matrix( ?Matrix )==== holds when <var>Matrix</var> is a list of 'cells' ordered by their (x,y) coordinates. Each 'cell' is described by 5 binary digits, which indicate the subject assigned to it, and the set of successors of the cell that are adjacent to it. <syntaxhighlight lang="prolog">matrix( Matrix ) :- layout( Layout ), matrix1( Layout, _Index, Matrix ). matrix1( [], _Index, [] ). matrix1( [(Row, Column)|Layout], Index, [Cell|Matrix] ) :- location_cell( Row, Column, Index, Cell ), findall( (Row1, Column1), ( successor( (Row, Column), (Row1, Column1) ), adjacent(Row, Row1), adjacent(Column, Column1) ), AdjacentSuccessorLocations ), location_cells( AdjacentSuccessorLocations, Index, AdjacentSuccessors ), adjacent_successors( Cell, AdjacentSuccessors ), matrix1( Layout, Index, Matrix ).</syntaxhighlight> ====cell( ?Subject, ?Cell )==== holds when <var>Cell</var> is the cell representation for <var>Subject</var>. <syntaxhighlight lang="prolog">cell( 1, cell(1,0,0,0,0,_) ). cell( 2, cell(0,1,0,0,0,_) ). cell( 3, cell(0,0,1,0,0,_) ). cell( 4, cell(0,0,0,1,0,_) ). cell( 5, cell(0,0,0,0,1,_) ).</syntaxhighlight> ====block( ?Subject, ?Block )==== holds when <var>Block</var> is a cell representation that is incompatible with <var>Subject</var>. <syntaxhighlight lang="prolog">block( 1, cell(0,_,_,_,_,_) ). block( 2, cell(_,0,_,_,_,_) ). block( 3, cell(_,_,0,_,_,_) ). block( 4, cell(_,_,_,0,_,_) ). block( 5, cell(_,_,_,_,0,_) ).</syntaxhighlight> ====adjacent_successors( ?Cell, ?AdjacentSuccesors )==== holds when <var>AdjacentSuccesors</var> is the set of successors of <var>Cell</var> that are adjacent to it. <syntaxhighlight lang="prolog">adjacent_successors( cell(_,_,_,_,_,AdjacentSuccesors), AdjacentSuccesors ).</syntaxhighlight> ====blocked( +Blocked, ?Subject )==== holds when all the cells in <var>Blocked</var> are incompatible with <var>Subject</var>. <syntaxhighlight lang="prolog">blocked( [], _Subject ). blocked( [Cell|Blocked], Subject ) :- block( Subject, Cell ), blocked( Blocked, Subject ).</syntaxhighlight> ====adjacent( +Coordinate0, ?Coordinate1 )==== holds when <var>Coordinate0</var> and <var>Coordinate1</var> are the same or differ by 1. <syntaxhighlight lang="prolog">adjacent( N, N ). adjacent( N0, N1 ) :- N1 is N0 + 1. adjacent( N0, N1 ) :- N1 is N0 - 1.</syntaxhighlight> ====location_cells( ?Locations, ?Index, ?Cells )==== holds when <var>Index</var> is a 6 &times; 6 array, <var>Locations</var> is a list of (Row,Column) pairs and <var>Cells</var> is the list of matching cells dereferenced from <var>Index</var>. <syntaxhighlight lang="prolog">location_cells( [], _Index, [] ). location_cells( [(Row, Column)|Locs], Index, [Cell|Cells] ) :- location_cell( Row, Column, Index, Cell ), location_cells( Locs, Index, Cells ).</syntaxhighlight> ====location_cell( ?Row, ?Column, ?Index, ?Cell )==== holds when <var>Index</var> is a 6 &times; 6 array with <var>Cell</var> at location (<var>Row</var>,<var>Column</var>). <syntaxhighlight lang="prolog">location_cell( Row, Column, Index, Cell ) :- select_nth( Row, Index, IndexRow ), select_nth( Column, IndexRow, Cell ).</syntaxhighlight> ====select_nth( ?N, ?Array, ?Element )==== holds when <var>Element</var> is the <var>N</var>th element of <var>Array</var>. <syntaxhighlight lang="prolog">select_nth( 1, array_6(A,_B,_C,_D,_E,_F), A ). select_nth( 2, array_6(_A,B,_C,_D,_E,_F), B ). select_nth( 3, array_6(_A,_B,C,_D,_E,_F), C ). select_nth( 4, array_6(_A,_B,_C,D,_E,_F), D ). select_nth( 5, array_6(_A,_B,_C,_D,E,_F), E ). select_nth( 6, array_6(_A,_B,_C,_D,_E,F), F ).</syntaxhighlight> ====successor( ?Coordinates0, ?Coordinates1 )==== holds when <var>Coordinates0</var> and <var>Coordinates1</var> are valid cell positions and <var>Coordinates0</var> &lt;<var>Coordinates1</var>. <syntaxhighlight lang="prolog">successor( Coordinates0, Coordinates1 ) :- layout( Layout ), append( _Prefix, [Coordinates0|Successors], Layout ), member( Coordinates1, Successors ).</syntaxhighlight> ====candidates( ?Subjects, ?Candidates )==== holds when there are 4 <var>Candidates</var> for each subject in <var>Subjects</var>. <syntaxhighlight lang="prolog">candidates( [], [] ). candidates( [Subj|Subjects], [[Subj,Subj,Subj,Subj]|Candidates] ) :- candidates( Subjects, Candidates ).</syntaxhighlight> ====layout( ?Layout )==== holds when <var>Layout</var> is the sequence of all (x,y) co-ordinates of valid 'cells'. <syntaxhighlight lang="prolog">layout( [ (1,2), (2,2),(2,3),(2,4),(2,5),(2,6), (3,2),(3,3),(3,4),(3,5), (4,2),(4,3),(4,4),(4,5), (5,1),(5,2),(5,3),(5,4),(5,5), (6,5) ] ).</syntaxhighlight> Load a small library of [[Puzzle Utilities]]. <syntaxhighlight lang="prolog">:- ensure_loaded( misc ).</syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/download/nut1.txt here]. === Result === This program reports '''29870''' solutions. 4f23f900dfc29fd18e35742e3c013cc1d1d8a8a7 84 63 2014-09-16T20:36:13Z John 2 /* allocation( +Cells, +NextSubject, +Subjects ) */ wikitext text/x-wiki ;Constrained Permutations in Prolog __NOTOC__ Problem posted to [http://groups.google.com/group/comp.lang.prolog/msg/a984ea325e0a4180 comp.lang.prolog] by Daniel Dudley ===Problem Statement=== <blockquote>A university was to hold an examination in 5 subjects: Norwegian, German, English, French and Spanish. In each of these languages there were 4 candidates. The examination room was therefore divided into 20 cells, as shown in the figure below (view this in a fixed font): <pre> X X X X X X X X X X X X X X X X X X X X</pre> The university's administration wanted to secure themselves against cheating. Candidates in the same language were to be completely isolated from each other - so much so that their cells were not to coincide even at the corners. A young lecturer was given the job of finding a solution to the problem, which he did, and justly received a pat on the back from the dean. Now it just so happens that the dean is an ardent prolog programmer in his spare time (how else could he make dean?) and, realizing that there could be several solutions to the problem, used his skills to find all solutions. Can you do the same? </blockquote> ===Note=== &quot;Several solutions&quot; doesn't really cover it! Assuming that by 'a solution' we mean finding a mapping between candidates and cells, then, having found one such solution, we can find 955,514,879 other members of its solution &quot;family&quot; quite easily, through: * ''candidate permutation'': There are (4!)⁵ permutations of the candidates within the cells allocated to their subjects; * ''subject permutation'': we can multiply the 'candidate permutations' by the 5! permutations of the subjects allocated to particular sets of cells. This means that the total number of solutions is 955514880 &times; D where D is the number of solution families i.e. solutions that cannot be derived from each other by candidate or subject permutation. Finding [[#Result|D]] is the more interesting problem solved by this program. ====nut1( ?Solutions )==== <var>Solutions</var> is the number of distinct solutions to the subject/cell allocation problem for any five different subjects. <syntaxhighlight lang="prolog">nut1( Solutions ) :- Norwegian = 1, German = 2, English = 3, French = 4, Spanish = 5, candidates( [Norwegian,German,English,French,Spanish], Candidates ), matrix( Cells ), count_solutions( allocate(Cells,Candidates), Solutions ).</syntaxhighlight> ====allocate( +Cells, +Candidates )==== holds when each cell in <var>Cells</var> holds a candidate from <var>Candidates</var>. <syntaxhighlight lang="prolog">allocate( Cells, Candidates ) :- allocation( Cells, 1, Candidates ).</syntaxhighlight> ====allocation( +Cells, +NextSubject, +Subjects )==== holds when <var>Cells</var> is a representation of a distinct solution to the subject/cell allocation problem. <var>NextSubject</var> is the highest subject that can be allocated next, while <var>Subjects</var> is the list of subjects needing allocation to <var>Cells</var>. Each subject is represented by a list, in which each occurrence of the subject number represents a candidate. We guarantee distinct solutions by ensuring that the allocation is made on the following basis: * For each subject: the location of the N+1th candidate must be a successor of the location of the Nth candidate - to eliminate 'candidate permutations'. * The location of the first candidate of the N+1th subject must be a successor of the location of the first candidate of the Nth subject - to eliminate 'subject permutations'. Operationally, at each step we select a candidate for a cell and constrain each of the cell's adjacent successors to have a different subject from it. <syntaxhighlight lang="prolog">allocation( [], _Next, [] ). allocation( [Cell|Cells], Next, Subjects ) :- allocate_candidate( Subjects, Next, Candidate, Subjects1, Next1 ), cell( Candidate, Cell ), adjacent_successors( Cell, AdjacentSuccessors ), blocked( AdjacentSuccessors, Candidate ), allocation( Cells, Next1, Subjects1 ).</syntaxhighlight> ====allocate_candidate( +Subjects, +Next, ?Candidate, ?Subjects1, ?Next1 )==== holds when <var>Candidate</var> is taken from <var>Subjects</var> leaving <var>Subjects1</var>. <var>Candidate</var> is represented by a subject number &le; <var>Next</var>. <var>Next1</var> is the highest subject that can be allocated to the next cell, ensuring that the first candidate for each subject is allocated in order. <syntaxhighlight lang="prolog">allocate_candidate( [Subject|Subjects], Next, Candidate, Subjects1, Next1 ) :- Subject = [Candidate|Candidates], Candidate =< Next, Next1 is max(Candidate+1,Next), residual_candidates( Candidates, Subjects, Subjects1 ). allocate_candidate( [Subject|Subjects], Next, Candidate, [Subject|Subjects1], Next1 ) :- Subject = [Candidate0|_Candidates], Candidate0 < Next, allocate_candidate( Subjects, Next, Candidate, Subjects1, Next1 ). residual_candidates( [], Subjects, Subjects ). residual_candidates( Candidates, Subjects, [Candidates|Subjects] ) :- Candidates = [_|_].</syntaxhighlight> ====matrix( ?Matrix )==== holds when <var>Matrix</var> is a list of 'cells' ordered by their (x,y) coordinates. Each 'cell' is described by 5 binary digits, which indicate the subject assigned to it, and the set of successors of the cell that are adjacent to it. <syntaxhighlight lang="prolog">matrix( Matrix ) :- layout( Layout ), matrix1( Layout, _Index, Matrix ). matrix1( [], _Index, [] ). matrix1( [(Row, Column)|Layout], Index, [Cell|Matrix] ) :- location_cell( Row, Column, Index, Cell ), findall( (Row1, Column1), ( successor( (Row, Column), (Row1, Column1) ), adjacent(Row, Row1), adjacent(Column, Column1) ), AdjacentSuccessorLocations ), location_cells( AdjacentSuccessorLocations, Index, AdjacentSuccessors ), adjacent_successors( Cell, AdjacentSuccessors ), matrix1( Layout, Index, Matrix ).</syntaxhighlight> ====cell( ?Subject, ?Cell )==== holds when <var>Cell</var> is the cell representation for <var>Subject</var>. <syntaxhighlight lang="prolog">cell( 1, cell(1,0,0,0,0,_) ). cell( 2, cell(0,1,0,0,0,_) ). cell( 3, cell(0,0,1,0,0,_) ). cell( 4, cell(0,0,0,1,0,_) ). cell( 5, cell(0,0,0,0,1,_) ).</syntaxhighlight> ====block( ?Subject, ?Block )==== holds when <var>Block</var> is a cell representation that is incompatible with <var>Subject</var>. <syntaxhighlight lang="prolog">block( 1, cell(0,_,_,_,_,_) ). block( 2, cell(_,0,_,_,_,_) ). block( 3, cell(_,_,0,_,_,_) ). block( 4, cell(_,_,_,0,_,_) ). block( 5, cell(_,_,_,_,0,_) ).</syntaxhighlight> ====adjacent_successors( ?Cell, ?AdjacentSuccesors )==== holds when <var>AdjacentSuccesors</var> is the set of successors of <var>Cell</var> that are adjacent to it. <syntaxhighlight lang="prolog">adjacent_successors( cell(_,_,_,_,_,AdjacentSuccesors), AdjacentSuccesors ).</syntaxhighlight> ====blocked( +Blocked, ?Subject )==== holds when all the cells in <var>Blocked</var> are incompatible with <var>Subject</var>. <syntaxhighlight lang="prolog">blocked( [], _Subject ). blocked( [Cell|Blocked], Subject ) :- block( Subject, Cell ), blocked( Blocked, Subject ).</syntaxhighlight> ====adjacent( +Coordinate0, ?Coordinate1 )==== holds when <var>Coordinate0</var> and <var>Coordinate1</var> are the same or differ by 1. <syntaxhighlight lang="prolog">adjacent( N, N ). adjacent( N0, N1 ) :- N1 is N0 + 1. adjacent( N0, N1 ) :- N1 is N0 - 1.</syntaxhighlight> ====location_cells( ?Locations, ?Index, ?Cells )==== holds when <var>Index</var> is a 6 &times; 6 array, <var>Locations</var> is a list of (Row,Column) pairs and <var>Cells</var> is the list of matching cells dereferenced from <var>Index</var>. <syntaxhighlight lang="prolog">location_cells( [], _Index, [] ). location_cells( [(Row, Column)|Locs], Index, [Cell|Cells] ) :- location_cell( Row, Column, Index, Cell ), location_cells( Locs, Index, Cells ).</syntaxhighlight> ====location_cell( ?Row, ?Column, ?Index, ?Cell )==== holds when <var>Index</var> is a 6 &times; 6 array with <var>Cell</var> at location (<var>Row</var>,<var>Column</var>). <syntaxhighlight lang="prolog">location_cell( Row, Column, Index, Cell ) :- select_nth( Row, Index, IndexRow ), select_nth( Column, IndexRow, Cell ).</syntaxhighlight> ====select_nth( ?N, ?Array, ?Element )==== holds when <var>Element</var> is the <var>N</var>th element of <var>Array</var>. <syntaxhighlight lang="prolog">select_nth( 1, array_6(A,_B,_C,_D,_E,_F), A ). select_nth( 2, array_6(_A,B,_C,_D,_E,_F), B ). select_nth( 3, array_6(_A,_B,C,_D,_E,_F), C ). select_nth( 4, array_6(_A,_B,_C,D,_E,_F), D ). select_nth( 5, array_6(_A,_B,_C,_D,E,_F), E ). select_nth( 6, array_6(_A,_B,_C,_D,_E,F), F ).</syntaxhighlight> ====successor( ?Coordinates0, ?Coordinates1 )==== holds when <var>Coordinates0</var> and <var>Coordinates1</var> are valid cell positions and <var>Coordinates0</var> &lt;<var>Coordinates1</var>. <syntaxhighlight lang="prolog">successor( Coordinates0, Coordinates1 ) :- layout( Layout ), append( _Prefix, [Coordinates0|Successors], Layout ), member( Coordinates1, Successors ).</syntaxhighlight> ====candidates( ?Subjects, ?Candidates )==== holds when there are 4 <var>Candidates</var> for each subject in <var>Subjects</var>. <syntaxhighlight lang="prolog">candidates( [], [] ). candidates( [Subj|Subjects], [[Subj,Subj,Subj,Subj]|Candidates] ) :- candidates( Subjects, Candidates ).</syntaxhighlight> ====layout( ?Layout )==== holds when <var>Layout</var> is the sequence of all (x,y) co-ordinates of valid 'cells'. <syntaxhighlight lang="prolog">layout( [ (1,2), (2,2),(2,3),(2,4),(2,5),(2,6), (3,2),(3,3),(3,4),(3,5), (4,2),(4,3),(4,4),(4,5), (5,1),(5,2),(5,3),(5,4),(5,5), (6,5) ] ).</syntaxhighlight> Load a small library of [[Puzzle Utilities]]. <syntaxhighlight lang="prolog">:- ensure_loaded( misc ).</syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/download/nut1.txt here]. === Result === This program reports '''29870''' solutions. eaafd9d6363ee46b3d87d0ca1d9055e697e5fcc7 0 3 56 38 2013-12-08T18:14:16Z John 2 /* Why use Prolog? */ wikitext text/x-wiki ;John Fletcher's home on the Web __NOTOC__ "Prolog is more than a language - it is a way of living :-)" Bart Demoen ==Prolog== Ever since I first learned Prolog, more than 20 years ago, it has been my preferred programming language. ===Why use Prolog?=== Prolog is a tool for solving problems, rather than producing "software products", and it will appeal to you if: * You want your programs to be readable, and have a close correspondence with their specifications; * Statements like x = x + 1 offend your mathematical sensibility; * You like to develop programs incrementally - with an interactive top-level, interactive debugging, and the ability to test (execute) program fragments independently; * You want fewer lines of code and (therefore) fewer faults; * You prefer to work with a handful of big ideas, rather than a lot of small ones; If you want to find out about Prolog on the Web, start with the [http://www.logic.at/prolog/faq/faq.html Frequently Asked Questions] for [https://groups.google.com/forum/?fromgroups#!forum/comp.lang.prolog comp.lang.prolog]. Other useful links include: * [https://binding-time.co.uk/lp_internet.html Logic Programming and the Internet]. Prolog is unequalled as a language for expressing queries and integrity constraints, and for processing text, which make it an excellent choice for Internet applications. * XML documents and Prolog terms have the same "tree" structure, which makes it easy to program with XML and Prolog. My free code for [https://binding-time.co.uk/xmlpl.html Parsing XML with Prolog] makes it even easier. * Recommended [https://binding-time.co.uk/prolog_books.html Prolog programming books]. * My solutions to some puzzles in Prolog: ** [[The Water Jugs Problem]], ** [[The Counterfeit Coin Puzzle]], ** [[Cheating Linguists]]?, ** [[Mister X]], ** [https://binding-time.co.uk/zoom_tracks.html Zoom Tracks], ** [https://binding-time.co.uk/whodunit.html Whodunit?] Although Prolog is regarded as a niche language, it's a very versatile language. I believe that the programming languages used in 2050 will owe more to Prolog than to any other language. d8a41cdbf25b2641bc6c996f980f86c7b9e635f7 64 56 2014-01-01T20:21:42Z John 2 /* Why use Prolog? */ wikitext text/x-wiki ;John Fletcher's home on the Web __NOTOC__ "Prolog is more than a language - it is a way of living :-)" Bart Demoen ==Prolog== Ever since I first learned Prolog, more than 20 years ago, it has been my preferred programming language. ===Why use Prolog?=== Prolog is a tool for solving problems, rather than producing "software products", and it will appeal to you if: * You want your programs to be readable, and have a close correspondence with their specifications; * Statements like x = x + 1 offend your mathematical sensibility; * You like to develop programs incrementally - with an interactive top-level, interactive debugging, and the ability to test (execute) program fragments independently; * You want fewer lines of code and (therefore) fewer faults; * You prefer to work with a handful of big ideas, rather than a lot of small ones; If you want to find out about Prolog on the Web, start with the [http://www.logic.at/prolog/faq/faq.html Frequently Asked Questions] for [https://groups.google.com/forum/?fromgroups#!forum/comp.lang.prolog comp.lang.prolog]. Other useful links include: * [https://binding-time.co.uk/lp_internet.html Logic Programming and the Internet]. Prolog is unequalled as a language for expressing queries and integrity constraints, and for processing text, which make it an excellent choice for Internet applications. * XML documents and Prolog terms have the same "tree" structure, which makes it easy to program with XML and Prolog. My free code for [https://binding-time.co.uk/xmlpl.html Parsing XML with Prolog] makes it even easier. * Recommended [https://binding-time.co.uk/prolog_books.html Prolog programming books]. * My solutions to some puzzles in Prolog: ** [[The Water Jugs Problem]], ** [[The Counterfeit Coin Puzzle]], ** [[Cheating Linguists]]?, ** [[Mister X]], ** [[Zoom Tracks]], ** [[Whodunit]]? Although Prolog is regarded as a niche language, it's a very versatile language. I believe that the programming languages used in 2050 will owe more to Prolog than to any other language. 08d58ac45ccca1ebb78198460f647bea7ae71c0c 70 64 2014-02-20T11:42:02Z John 2 /* Why use Prolog? */ wikitext text/x-wiki ;John Fletcher's home on the Web __NOTOC__ "Prolog is more than a language - it is a way of living :-)" Bart Demoen ==Prolog== Ever since I first learned Prolog, more than 20 years ago, it has been my preferred programming language. ===Why use Prolog?=== Prolog is a tool for solving problems, rather than producing "software products", and it will appeal to you if: * You want your programs to be readable, and to have a close correspondence with their specifications; * Statements like x = x + 1 offend your mathematical sensibility; * You like to develop programs incrementally - with an interactive top-level, interactive debugging, and the ability to test (execute) program fragments independently; * You want fewer lines of code and (therefore) fewer faults; * You prefer to work with a handful of big ideas, rather than a lot of small ones; If you want to find out about Prolog on the Web, start with the [http://www.logic.at/prolog/faq/faq.html Frequently Asked Questions] for [https://groups.google.com/forum/?fromgroups#!forum/comp.lang.prolog comp.lang.prolog]. Other useful links include: * [https://binding-time.co.uk/lp_internet.html Logic Programming and the Internet]. Prolog is unequalled as a language for expressing queries and integrity constraints, and for processing text, which make it an excellent choice for Internet applications. * XML documents and Prolog terms have the same "tree" structure, which makes it easy to program with XML and Prolog. My free code for [https://binding-time.co.uk/xmlpl.html Parsing XML with Prolog] makes it even easier. * Recommended [https://binding-time.co.uk/prolog_books.html Prolog programming books]. * My solutions to some puzzles in Prolog: ** [[The Water Jugs Problem]], ** [[The Counterfeit Coin Puzzle]], ** [[Cheating Linguists]]?, ** [[Mister X]], ** [[Zoom Tracks]], ** [[Whodunit]]? Although Prolog is regarded as a niche language, it's a very versatile language. I believe that the programming languages used in 2050 will owe more to Prolog than to any other language. db89293e78babde54e190c37cf0086cb73d7ab4e 71 70 2014-05-04T23:18:33Z John 2 /* Why use Prolog? */ wikitext text/x-wiki ;John Fletcher's home on the Web __NOTOC__ "Prolog is more than a language - it is a way of living :-)" Bart Demoen ==Prolog== Ever since I first learned Prolog, more than 20 years ago, it has been my preferred programming language. ===Why use Prolog?=== Prolog is a tool for solving problems, rather than producing "software products", and it will appeal to you if: * You want your programs to be readable, and to have a close correspondence with their specifications; * Statements like x = x + 1 offend your mathematical sensibility; * You like to develop programs incrementally - with an interactive top-level, interactive debugging, and the ability to test (execute) program fragments independently; * You want fewer lines of code and (therefore) fewer faults; * You prefer to work with a handful of big ideas, rather than a lot of small ones; If you want to find out about Prolog on the Web, start with the [http://www.logic.at/prolog/faq/faq.html Frequently Asked Questions] for [https://groups.google.com/forum/?fromgroups#!forum/comp.lang.prolog comp.lang.prolog]. Other useful links include: * [https://binding-time.co.uk/lp_internet.html Logic Programming and the Internet]. Prolog is unequalled as a language for expressing queries and integrity constraints, and for processing text, which make it an excellent choice for Internet applications. * XML documents and Prolog terms have the same "tree" structure, which makes it easy to program with XML and Prolog. My free code for [[Parsing XML with Prolog]] makes it even easier. * Recommended [https://binding-time.co.uk/prolog_books.html Prolog programming books]. * My solutions to some puzzles in Prolog: ** [[The Water Jugs Problem]], ** [[The Counterfeit Coin Puzzle]], ** [[Cheating Linguists]]?, ** [[Mister X]], ** [[Zoom Tracks]], ** [[Whodunit]]? Although Prolog is regarded as a niche language, it's a very versatile language. I believe that the programming languages used in 2050 will owe more to Prolog than to any other language. 646bcdce34bdfa7c4bc149d370e49b11ab079806 76 71 2014-06-07T11:15:18Z John 2 wikitext text/x-wiki ;John Fletcher's home on the Web __NOTOC__ "Prolog is more than a language - it is a way of living :-)" Bart Demoen ==Prolog== Ever since I first learned Prolog, more than 20 years ago, it has been my preferred programming language. ===Why use Prolog?=== Prolog is a tool for solving problems, rather than producing "software products", and it will appeal to you if: * You want your programs to be readable, and to have a close correspondence with their specifications; * Statements like x = x + 1 offend your mathematical sensibility; * You like to develop programs incrementally - with an interactive top-level, interactive debugging, and the ability to test (execute) program fragments independently; * You want fewer lines of code and (therefore) fewer faults; * You prefer to work with a handful of big ideas, rather than a lot of small ones; If you want to find out about Prolog on the Web, start with the [http://www.logic.at/prolog/faq/faq.html Frequently Asked Questions] for [https://groups.google.com/forum/?fromgroups#!forum/comp.lang.prolog comp.lang.prolog]. Other useful links include: * [[Logic Programming and the Internet]]. Prolog is unequalled as a language for expressing queries and integrity constraints, and for processing text, which make it an excellent choice for Internet applications. * XML documents and Prolog terms have the same "tree" structure, which makes it easy to program with XML and Prolog. My free code for [[Parsing XML with Prolog]] makes it even easier. * Recommended [https://binding-time.co.uk/prolog_books.html Prolog programming books]. * My solutions to some puzzles in Prolog: ** [[The Water Jugs Problem]], ** [[The Counterfeit Coin Puzzle]], ** [[Cheating Linguists]]?, ** [[Mister X]], ** [[Zoom Tracks]], ** [[Whodunit]]? Although Prolog is regarded as a niche language, it's a very versatile language. I believe that the programming languages used in 2050 will owe more to Prolog than to any other language. 9a657d872664ca2e7ea1083f6e7770b367e74bfd 99 76 2015-05-07T13:21:29Z John 2 /* Why use Prolog? */ wikitext text/x-wiki ;John Fletcher's home on the Web __NOTOC__ "Prolog is more than a language - it is a way of living :-)" Bart Demoen ==Prolog== Ever since I first learned Prolog, more than 20 years ago, it has been my preferred programming language. ===Why use Prolog?=== Prolog is a tool for solving problems, rather than producing &ldquo;software products&rdquo;, and it will appeal to you if: * You want your programs to be readable, and to have a close correspondence with their specifications; * Statements like x = x + 1 offend your mathematical sensibility; * You like to develop programs incrementally &ndash; with an interactive top-level, interactive debugging, and the ability to test (execute) program fragments independently; * You want fewer lines of code and therefore fewer faults; * You prefer to work with a handful of big ideas, rather than a lot of small ones; If you want to find out about Prolog on the Web, start with the [http://www.logic.at/prolog/faq/faq.html Frequently Asked Questions] for [https://groups.google.com/forum/?fromgroups#!forum/comp.lang.prolog comp.lang.prolog]. Other useful links include: * [[Logic Programming and the Internet]]. Prolog is unequalled as a language for expressing queries and integrity constraints, and for processing text, which make it an excellent choice for Internet applications. * XML documents and Prolog terms have the same &lsquo;tree&rsquo; structure, which makes it easy to program with XML and Prolog. My free code for [[Parsing XML with Prolog]] makes it even easier. * Recommended [https://binding-time.co.uk/prolog_books.html Prolog programming books]. * My solutions to some puzzles in Prolog: ** [[The Water Jugs Problem]], ** [[The Counterfeit Coin Puzzle]], ** [[Cheating Linguists]]?, ** [[Mister X]], ** [[Zoom Tracks]], ** [[Whodunit]]? Although Prolog is regarded as a niche language, it's a very versatile language. I believe that the programming languages used in 2050 will owe more to Prolog than to any other language. ca9dac753d2815a4914b62691d144aea79140499 101 99 2015-05-11T11:38:03Z John 2 wikitext text/x-wiki ;John Fletcher's home on the Web __NOTOC__ “Prolog is more than a language - it is a way of living :-)” Bart Demoen ==Prolog== Ever since I first learned Prolog, more than 20 years ago, it has been my preferred programming language. ===Why use Prolog?=== Prolog is a tool for solving problems, rather than producing “software products”, and it will appeal to you if: * You want your programs to be readable, and to have a close correspondence with their specifications; * Statements like x = x + 1 offend your mathematical sensibility; * You like to develop programs incrementally – with an interactive top-level, interactive debugging, and the ability to test (execute) program fragments independently; * You want fewer lines of code and therefore fewer faults; * You prefer to work with a handful of big ideas, rather than a lot of small ones; If you want to find out about Prolog on the Web, start with the [http://www.logic.at/prolog/faq/faq.html Frequently Asked Questions] for [https://groups.google.com/forum/?fromgroups#!forum/comp.lang.prolog comp.lang.prolog]. Other useful links include: * [[Logic Programming and the Internet]]. Prolog is unequalled as a language for expressing queries and integrity constraints, and for processing text, which make it an excellent choice for Internet applications. * XML documents and Prolog terms have the same ‘tree’ structure, which makes it easy to program with XML and Prolog. My free code for [[Parsing XML with Prolog]] makes it even easier. * Recommended [https://binding-time.co.uk/prolog_books.html Prolog programming books]. * My solutions to some puzzles in Prolog: ** [[The Water Jugs Problem]], ** [[The Counterfeit Coin Puzzle]], ** [[Cheating Linguists]]?, ** [[Mister X]], ** [[Zoom Tracks]], ** [[Whodunit]]? Although Prolog is regarded as a niche language, it's a very versatile language. I believe that the programming languages used in 2050 will owe more to Prolog than to any other language. ed80261721cfb4c7bdd20e351750ffc6c87aeed1 0 13 57 2013-12-08T18:37:26Z John 2 Created page with "__NOTOC__ Although this problem has a straightforward solution, it does demonstrate the value of "Prolog thinking" in understanding the problem, which relates to nondeterminis..." wikitext text/x-wiki __NOTOC__ Although this problem has a straightforward solution, it does demonstrate the value of "Prolog thinking" in understanding the problem, which relates to nondeterminism -- especially "don't know" nondeterminism, and an appropriate use of "lemmas". == Problem: == Problem as posted to [http://groups.google.com/group/de.comp.lang.java/msg/12cb7c2083cde4f8 comp.lang.prolog] by Thorsten Seelend. Also known as Hans Freudenthal's [http://people.sc.fsu.edu/~jburkardt/fun/puzzles/impossible_puzzle.html Impossible Puzzle]. <blockquote>Mister X thinks about two integers between 1 and 100 excluding: </blockquote> '''MISTERX: Two integers, X and Y between 2 and 99 (My formalization of the given information)''' <syntaxhighlight lang="prolog">two_integers( X, Y ) :- between( 2, 98, X ), between( X, 99, Y ).</syntaxhighlight> He tells Susan the Sum of them and Peter their Product. Their task is to get the two original values without telling each other the numbers that Mister X told them. <blockquote>After some time Peter says: "I can't say definitively which are the original numbers."</blockquote> '''PETER1: There is more than one pair of factors giving Product''' <syntaxhighlight lang="prolog">property( peter1, Product ) :- \+ unique_factors( Product ).</syntaxhighlight> <blockquote>Then Susan responds: "Neither can I, but I knew that you couldn't know it." </blockquote> '''SUSAN1: The product of ''every'' pair of summands giving Sum has the property PETER1''' <syntaxhighlight lang="prolog">property( susan1, Sum ) :- forall( ordered_summands(Sum, X, Y), peter1(X * Y) ).</syntaxhighlight> <blockquote>Peter: "Really? So now I know the original numbers".</blockquote> '''PETER2: ''exactly one'' pair of factors giving Product gives a sum with the property SUSAN1''' <syntaxhighlight lang="prolog">property( peter2, Product ) :- unique_solution( (ordered_factors(Product, X, Y), susan1(X+Y)) ).</syntaxhighlight> <blockquote>Susan: "Now I know them too".</blockquote> '''SUSAN2: ''exactly one'' pair of summands giving Sum has a product with the property PETER2''' <syntaxhighlight lang="prolog">property( susan2, Sum ) :- unique_solution( (ordered_summands(Sum, X, Y), peter2(X * Y)) ).</syntaxhighlight> <blockquote>Question: What are the two numbers that Mister X thought of?</blockquote> '''Unique solution''' <syntaxhighlight lang="prolog">solve( X, Y ) :- unique_solution( mister_x(X, Y) ). mister_x( X, Y ) :- two_integers( X, Y ), Sum is X + Y, Product is X * Y, peter1( Product ), susan1( Sum ), peter2( Product ), susan2( Sum ).</syntaxhighlight> == Macros == <syntaxhighlight lang="prolog">peter1( Product ) :- lemma( peter1, Product ). peter2( Product ) :- lemma( peter2, Product ). susan1( Sum ) :- lemma( susan1, Sum ). susan2( Sum ) :- lemma( susan2, Sum ).</syntaxhighlight> == Lemmas == ====lemma( +Property, +Expression )==== holds wherever <var>Property</var> holds for <var>Expression</var>. Asserted facts are used to record successful (''positive'') or failed (''negative'') demonstrations. This saves recomputation without changing the meaning of the pure program. Although the use of side-effects is generally undesirable, the use of lemmas is justified when the alternative is to compromise performance or clarity. <syntaxhighlight lang="prolog">:- dynamic positive/2, negative/2. lemma( Name, Expression ) :- Value is Expression, ( positive( Value, Name ) -> true ; \+ negative( Value, Name ) -> ( property(Name, Value) -> assert( positive(Value, Name) ) ; otherwise -> assert( negative(Value, Name) ), fail ) ).</syntaxhighlight> == Supporting Predicates == ====ordered_summands( +Sum, ?X, ?Y )==== when <var>X</var> &le; <var>Y</var> and Sum = <var>X</var>+<var>Y</var>. NB: Since <var>X</var>&le;<var>Y</var> it follows that <var>X</var> &le; <var>Sum</var>/2. <syntaxhighlight lang="prolog">ordered_summands( Z, X, Y ) :- Half is Z//2, between( 2, Half, X ), Y is Z - X, between( X, 98, Y ).</syntaxhighlight> ====ordered_factors( +Product, ?X, ?Y )==== when <var>X</var> &le; <var>Y</var> and <var>Product</var> = <var>X</var> &times; <var>Y</var>. NB: Since <var>X</var>&le;<var>Y</var> it follows that <var>X</var> &le; &radic;<var>Product</var>. <syntaxhighlight lang="prolog">ordered_factors( Z, X, Y ) :- integer_sqrt( Z, SqrtZ ), between( 2, SqrtZ, X ), Y is Z // X, between( X, 99, Y ), Z =:= X * Y.</syntaxhighlight> ====unique_factors( +Product )==== when <var>Product</var> has exactly one pair of factors. <syntaxhighlight lang="prolog">unique_factors( Product ) :- ordered_factors( Product, X, _Y ), \+ (ordered_factors(Product, X1, _Y1), X1 =\= X).</syntaxhighlight> ====integer_sqrt( +N, ?Sqrt )==== when <var>Sqrt</var>² &le; <var>N</var> and (<var>Sqrt</var>+1)² &ge; <var>N</var>. <syntaxhighlight lang="prolog">integer_sqrt( N, Sqrt ) :- Float is N * 1.0, sqrt( Float, FSqrt ), Sqrt is integer(FSqrt).</syntaxhighlight> Load a small library of [[Puzzle Utilities]]. <syntaxhighlight lang="prolog">:- ensure_loaded( misc ).</syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/download/mister_x.txt here]. == Result == This program finds X and Y as '''4''' and '''13'''. == Tabling == Using tabling, rather than explicit lemmas, can simplify code. [https://binding-time.co.uk/download/xsb_mister_x.txt A version adapted for XSB Prolog is available here.] 919c1bf9e199208df1e4aa7a0da87f6ac7a42693 58 57 2013-12-18T16:53:00Z John 2 /* Problem: */ wikitext text/x-wiki __NOTOC__ Although this problem has a straightforward solution, it does demonstrate the value of "Prolog thinking" in understanding the problem, which relates to nondeterminism -- especially "don't know" nondeterminism, and an appropriate use of "lemmas". == Problem: == Problem as posted to comp.lang.prolog by Thorsten Seelend[http://groups.google.com/group/de.comp.lang.java/msg/12cb7c2083cde4f8]. Also known as Hans Freudenthal's Impossible Puzzle[http://people.sc.fsu.edu/~jburkardt/fun/puzzles/impossible_puzzle.html]. <blockquote>Mister X thinks about two integers between 1 and 100 excluding: </blockquote> '''MISTERX: Two integers, X and Y between 2 and 99 (My formalization of the given information)''' <syntaxhighlight lang="prolog">two_integers( X, Y ) :- between( 2, 98, X ), between( X, 99, Y ).</syntaxhighlight> He tells Susan the Sum of them and Peter their Product. Their task is to get the two original values without telling each other the numbers that Mister X told them. <blockquote>After some time Peter says: "I can't say definitively which are the original numbers."</blockquote> '''PETER1: There is more than one pair of factors giving Product''' <syntaxhighlight lang="prolog">property( peter1, Product ) :- \+ unique_factors( Product ).</syntaxhighlight> <blockquote>Then Susan responds: "Neither can I, but I knew that you couldn't know it." </blockquote> '''SUSAN1: The product of ''every'' pair of summands giving Sum has the property PETER1''' <syntaxhighlight lang="prolog">property( susan1, Sum ) :- forall( ordered_summands(Sum, X, Y), peter1(X * Y) ).</syntaxhighlight> <blockquote>Peter: "Really? So now I know the original numbers".</blockquote> '''PETER2: ''exactly one'' pair of factors giving Product gives a sum with the property SUSAN1''' <syntaxhighlight lang="prolog">property( peter2, Product ) :- unique_solution( (ordered_factors(Product, X, Y), susan1(X+Y)) ).</syntaxhighlight> <blockquote>Susan: "Now I know them too".</blockquote> '''SUSAN2: ''exactly one'' pair of summands giving Sum has a product with the property PETER2''' <syntaxhighlight lang="prolog">property( susan2, Sum ) :- unique_solution( (ordered_summands(Sum, X, Y), peter2(X * Y)) ).</syntaxhighlight> <blockquote>Question: What are the two numbers that Mister X thought of?</blockquote> '''Unique solution''' <syntaxhighlight lang="prolog">solve( X, Y ) :- unique_solution( mister_x(X, Y) ). mister_x( X, Y ) :- two_integers( X, Y ), Sum is X + Y, Product is X * Y, peter1( Product ), susan1( Sum ), peter2( Product ), susan2( Sum ).</syntaxhighlight> == Macros == <syntaxhighlight lang="prolog">peter1( Product ) :- lemma( peter1, Product ). peter2( Product ) :- lemma( peter2, Product ). susan1( Sum ) :- lemma( susan1, Sum ). susan2( Sum ) :- lemma( susan2, Sum ).</syntaxhighlight> == Lemmas == ====lemma( +Property, +Expression )==== holds wherever <var>Property</var> holds for <var>Expression</var>. Asserted facts are used to record successful (''positive'') or failed (''negative'') demonstrations. This saves recomputation without changing the meaning of the pure program. Although the use of side-effects is generally undesirable, the use of lemmas is justified when the alternative is to compromise performance or clarity. <syntaxhighlight lang="prolog">:- dynamic positive/2, negative/2. lemma( Name, Expression ) :- Value is Expression, ( positive( Value, Name ) -> true ; \+ negative( Value, Name ) -> ( property(Name, Value) -> assert( positive(Value, Name) ) ; otherwise -> assert( negative(Value, Name) ), fail ) ).</syntaxhighlight> == Supporting Predicates == ====ordered_summands( +Sum, ?X, ?Y )==== when <var>X</var> &le; <var>Y</var> and Sum = <var>X</var>+<var>Y</var>. NB: Since <var>X</var>&le;<var>Y</var> it follows that <var>X</var> &le; <var>Sum</var>/2. <syntaxhighlight lang="prolog">ordered_summands( Z, X, Y ) :- Half is Z//2, between( 2, Half, X ), Y is Z - X, between( X, 98, Y ).</syntaxhighlight> ====ordered_factors( +Product, ?X, ?Y )==== when <var>X</var> &le; <var>Y</var> and <var>Product</var> = <var>X</var> &times; <var>Y</var>. NB: Since <var>X</var>&le;<var>Y</var> it follows that <var>X</var> &le; &radic;<var>Product</var>. <syntaxhighlight lang="prolog">ordered_factors( Z, X, Y ) :- integer_sqrt( Z, SqrtZ ), between( 2, SqrtZ, X ), Y is Z // X, between( X, 99, Y ), Z =:= X * Y.</syntaxhighlight> ====unique_factors( +Product )==== when <var>Product</var> has exactly one pair of factors. <syntaxhighlight lang="prolog">unique_factors( Product ) :- ordered_factors( Product, X, _Y ), \+ (ordered_factors(Product, X1, _Y1), X1 =\= X).</syntaxhighlight> ====integer_sqrt( +N, ?Sqrt )==== when <var>Sqrt</var>² &le; <var>N</var> and (<var>Sqrt</var>+1)² &ge; <var>N</var>. <syntaxhighlight lang="prolog">integer_sqrt( N, Sqrt ) :- Float is N * 1.0, sqrt( Float, FSqrt ), Sqrt is integer(FSqrt).</syntaxhighlight> Load a small library of [[Puzzle Utilities]]. <syntaxhighlight lang="prolog">:- ensure_loaded( misc ).</syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/download/mister_x.txt here]. == Result == This program finds X and Y as '''4''' and '''13'''. == Tabling == Using tabling, rather than explicit lemmas, can simplify code. [https://binding-time.co.uk/download/xsb_mister_x.txt A version adapted for XSB Prolog is available here.] 7bbc2d2c548cb6bb1c073b91f0c359918c8a5f01 59 58 2013-12-21T22:54:53Z John 2 /* Problem: */ wikitext text/x-wiki __NOTOC__ Although this problem has a straightforward solution, it does demonstrate the value of "Prolog thinking" in understanding the problem, which relates to nondeterminism -- especially "don't know" nondeterminism, and an appropriate use of "lemmas". == Problem: == [http://groups.google.com/group/de.comp.lang.java/msg/12cb7c2083cde4f8 Problem as posted to comp.lang.prolog] by Thorsten Seelend . Also known as [http://people.sc.fsu.edu/~jburkardt/fun/puzzles/impossible_puzzle.html Hans Freudenthal's Impossible Puzzle]. <blockquote>Mister X thinks about two integers between 1 and 100 excluding: </blockquote> '''MISTERX: Two integers, X and Y between 2 and 99 (My formalization of the given information)''' <syntaxhighlight lang="prolog">two_integers( X, Y ) :- between( 2, 98, X ), between( X, 99, Y ).</syntaxhighlight> He tells Susan the Sum of them and Peter their Product. Their task is to get the two original values without telling each other the numbers that Mister X told them. <blockquote>After some time Peter says: "I can't say definitively which are the original numbers."</blockquote> '''PETER1: There is more than one pair of factors giving Product''' <syntaxhighlight lang="prolog">property( peter1, Product ) :- \+ unique_factors( Product ).</syntaxhighlight> <blockquote>Then Susan responds: "Neither can I, but I knew that you couldn't know it." </blockquote> '''SUSAN1: The product of ''every'' pair of summands giving Sum has the property PETER1''' <syntaxhighlight lang="prolog">property( susan1, Sum ) :- forall( ordered_summands(Sum, X, Y), peter1(X * Y) ).</syntaxhighlight> <blockquote>Peter: "Really? So now I know the original numbers".</blockquote> '''PETER2: ''exactly one'' pair of factors giving Product gives a sum with the property SUSAN1''' <syntaxhighlight lang="prolog">property( peter2, Product ) :- unique_solution( (ordered_factors(Product, X, Y), susan1(X+Y)) ).</syntaxhighlight> <blockquote>Susan: "Now I know them too".</blockquote> '''SUSAN2: ''exactly one'' pair of summands giving Sum has a product with the property PETER2''' <syntaxhighlight lang="prolog">property( susan2, Sum ) :- unique_solution( (ordered_summands(Sum, X, Y), peter2(X * Y)) ).</syntaxhighlight> <blockquote>Question: What are the two numbers that Mister X thought of?</blockquote> '''Unique solution''' <syntaxhighlight lang="prolog">solve( X, Y ) :- unique_solution( mister_x(X, Y) ). mister_x( X, Y ) :- two_integers( X, Y ), Sum is X + Y, Product is X * Y, peter1( Product ), susan1( Sum ), peter2( Product ), susan2( Sum ).</syntaxhighlight> == Macros == <syntaxhighlight lang="prolog">peter1( Product ) :- lemma( peter1, Product ). peter2( Product ) :- lemma( peter2, Product ). susan1( Sum ) :- lemma( susan1, Sum ). susan2( Sum ) :- lemma( susan2, Sum ).</syntaxhighlight> == Lemmas == ====lemma( +Property, +Expression )==== holds wherever <var>Property</var> holds for <var>Expression</var>. Asserted facts are used to record successful (''positive'') or failed (''negative'') demonstrations. This saves recomputation without changing the meaning of the pure program. Although the use of side-effects is generally undesirable, the use of lemmas is justified when the alternative is to compromise performance or clarity. <syntaxhighlight lang="prolog">:- dynamic positive/2, negative/2. lemma( Name, Expression ) :- Value is Expression, ( positive( Value, Name ) -> true ; \+ negative( Value, Name ) -> ( property(Name, Value) -> assert( positive(Value, Name) ) ; otherwise -> assert( negative(Value, Name) ), fail ) ).</syntaxhighlight> == Supporting Predicates == ====ordered_summands( +Sum, ?X, ?Y )==== when <var>X</var> &le; <var>Y</var> and Sum = <var>X</var>+<var>Y</var>. NB: Since <var>X</var>&le;<var>Y</var> it follows that <var>X</var> &le; <var>Sum</var>/2. <syntaxhighlight lang="prolog">ordered_summands( Z, X, Y ) :- Half is Z//2, between( 2, Half, X ), Y is Z - X, between( X, 98, Y ).</syntaxhighlight> ====ordered_factors( +Product, ?X, ?Y )==== when <var>X</var> &le; <var>Y</var> and <var>Product</var> = <var>X</var> &times; <var>Y</var>. NB: Since <var>X</var>&le;<var>Y</var> it follows that <var>X</var> &le; &radic;<var>Product</var>. <syntaxhighlight lang="prolog">ordered_factors( Z, X, Y ) :- integer_sqrt( Z, SqrtZ ), between( 2, SqrtZ, X ), Y is Z // X, between( X, 99, Y ), Z =:= X * Y.</syntaxhighlight> ====unique_factors( +Product )==== when <var>Product</var> has exactly one pair of factors. <syntaxhighlight lang="prolog">unique_factors( Product ) :- ordered_factors( Product, X, _Y ), \+ (ordered_factors(Product, X1, _Y1), X1 =\= X).</syntaxhighlight> ====integer_sqrt( +N, ?Sqrt )==== when <var>Sqrt</var>² &le; <var>N</var> and (<var>Sqrt</var>+1)² &ge; <var>N</var>. <syntaxhighlight lang="prolog">integer_sqrt( N, Sqrt ) :- Float is N * 1.0, sqrt( Float, FSqrt ), Sqrt is integer(FSqrt).</syntaxhighlight> Load a small library of [[Puzzle Utilities]]. <syntaxhighlight lang="prolog">:- ensure_loaded( misc ).</syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/download/mister_x.txt here]. == Result == This program finds X and Y as '''4''' and '''13'''. == Tabling == Using tabling, rather than explicit lemmas, can simplify code. [https://binding-time.co.uk/download/xsb_mister_x.txt A version adapted for XSB Prolog is available here.] ff103fae117951871185ae7dafa541a62b4bd53d 60 59 2013-12-21T22:58:09Z John 2 /* Problem: */ wikitext text/x-wiki __NOTOC__ Although this problem has a straightforward solution, it does demonstrate the value of "Prolog thinking" in understanding the problem, which relates to nondeterminism -- especially "don't know" nondeterminism, and an appropriate use of "lemmas". == Problem: == [http://groups.google.com/group/de.comp.lang.java/msg/12cb7c2083cde4f8 Problem as posted to comp.lang.prolog] by Thorsten Seelend. Also known as [http://people.sc.fsu.edu/~jburkardt/fun/puzzles/impossible_puzzle.html Hans Freudenthal's Impossible Puzzle]. <blockquote>Mister X thinks about two integers between 1 and 100 excluding: </blockquote> '''MISTERX: Two integers, X and Y between 2 and 99 (My formalization of the given information)''' <syntaxhighlight lang="prolog">two_integers( X, Y ) :- between( 2, 98, X ), between( X, 99, Y ).</syntaxhighlight> He tells Susan the Sum of them and Peter their Product. Their task is to get the two original values without telling each other the numbers that Mister X told them. <blockquote>After some time Peter says: "I can't say definitively which are the original numbers."</blockquote> '''PETER1: There is more than one pair of factors giving Product''' <syntaxhighlight lang="prolog">property( peter1, Product ) :- \+ unique_factors( Product ).</syntaxhighlight> <blockquote>Then Susan responds: "Neither can I, but I knew that you couldn't know it." </blockquote> '''SUSAN1: The product of ''every'' pair of summands giving Sum has the property PETER1''' <syntaxhighlight lang="prolog">property( susan1, Sum ) :- forall( ordered_summands(Sum, X, Y), peter1(X * Y) ).</syntaxhighlight> <blockquote>Peter: "Really? So now I know the original numbers".</blockquote> '''PETER2: ''exactly one'' pair of factors giving Product gives a sum with the property SUSAN1''' <syntaxhighlight lang="prolog">property( peter2, Product ) :- unique_solution( (ordered_factors(Product, X, Y), susan1(X+Y)) ).</syntaxhighlight> <blockquote>Susan: "Now I know them too".</blockquote> '''SUSAN2: ''exactly one'' pair of summands giving Sum has a product with the property PETER2''' <syntaxhighlight lang="prolog">property( susan2, Sum ) :- unique_solution( (ordered_summands(Sum, X, Y), peter2(X * Y)) ).</syntaxhighlight> <blockquote>Question: What are the two numbers that Mister X thought of?</blockquote> '''Unique solution''' <syntaxhighlight lang="prolog">solve( X, Y ) :- unique_solution( mister_x(X, Y) ). mister_x( X, Y ) :- two_integers( X, Y ), Sum is X + Y, Product is X * Y, peter1( Product ), susan1( Sum ), peter2( Product ), susan2( Sum ).</syntaxhighlight> == Macros == <syntaxhighlight lang="prolog">peter1( Product ) :- lemma( peter1, Product ). peter2( Product ) :- lemma( peter2, Product ). susan1( Sum ) :- lemma( susan1, Sum ). susan2( Sum ) :- lemma( susan2, Sum ).</syntaxhighlight> == Lemmas == ====lemma( +Property, +Expression )==== holds wherever <var>Property</var> holds for <var>Expression</var>. Asserted facts are used to record successful (''positive'') or failed (''negative'') demonstrations. This saves recomputation without changing the meaning of the pure program. Although the use of side-effects is generally undesirable, the use of lemmas is justified when the alternative is to compromise performance or clarity. <syntaxhighlight lang="prolog">:- dynamic positive/2, negative/2. lemma( Name, Expression ) :- Value is Expression, ( positive( Value, Name ) -> true ; \+ negative( Value, Name ) -> ( property(Name, Value) -> assert( positive(Value, Name) ) ; otherwise -> assert( negative(Value, Name) ), fail ) ).</syntaxhighlight> == Supporting Predicates == ====ordered_summands( +Sum, ?X, ?Y )==== when <var>X</var> &le; <var>Y</var> and Sum = <var>X</var>+<var>Y</var>. NB: Since <var>X</var>&le;<var>Y</var> it follows that <var>X</var> &le; <var>Sum</var>/2. <syntaxhighlight lang="prolog">ordered_summands( Z, X, Y ) :- Half is Z//2, between( 2, Half, X ), Y is Z - X, between( X, 98, Y ).</syntaxhighlight> ====ordered_factors( +Product, ?X, ?Y )==== when <var>X</var> &le; <var>Y</var> and <var>Product</var> = <var>X</var> &times; <var>Y</var>. NB: Since <var>X</var>&le;<var>Y</var> it follows that <var>X</var> &le; &radic;<var>Product</var>. <syntaxhighlight lang="prolog">ordered_factors( Z, X, Y ) :- integer_sqrt( Z, SqrtZ ), between( 2, SqrtZ, X ), Y is Z // X, between( X, 99, Y ), Z =:= X * Y.</syntaxhighlight> ====unique_factors( +Product )==== when <var>Product</var> has exactly one pair of factors. <syntaxhighlight lang="prolog">unique_factors( Product ) :- ordered_factors( Product, X, _Y ), \+ (ordered_factors(Product, X1, _Y1), X1 =\= X).</syntaxhighlight> ====integer_sqrt( +N, ?Sqrt )==== when <var>Sqrt</var>² &le; <var>N</var> and (<var>Sqrt</var>+1)² &ge; <var>N</var>. <syntaxhighlight lang="prolog">integer_sqrt( N, Sqrt ) :- Float is N * 1.0, sqrt( Float, FSqrt ), Sqrt is integer(FSqrt).</syntaxhighlight> Load a small library of [[Puzzle Utilities]]. <syntaxhighlight lang="prolog">:- ensure_loaded( misc ).</syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/download/mister_x.txt here]. == Result == This program finds X and Y as '''4''' and '''13'''. == Tabling == Using tabling, rather than explicit lemmas, can simplify code. [https://binding-time.co.uk/download/xsb_mister_x.txt A version adapted for XSB Prolog is available here.] 2b1702d695b3747ebdb0f25f5a4a4584ef9c94bc 69 60 2014-02-15T16:39:46Z John 2 /* lemma( +Property, +Expression ) */ wikitext text/x-wiki __NOTOC__ Although this problem has a straightforward solution, it does demonstrate the value of "Prolog thinking" in understanding the problem, which relates to nondeterminism -- especially "don't know" nondeterminism, and an appropriate use of "lemmas". == Problem: == [http://groups.google.com/group/de.comp.lang.java/msg/12cb7c2083cde4f8 Problem as posted to comp.lang.prolog] by Thorsten Seelend. Also known as [http://people.sc.fsu.edu/~jburkardt/fun/puzzles/impossible_puzzle.html Hans Freudenthal's Impossible Puzzle]. <blockquote>Mister X thinks about two integers between 1 and 100 excluding: </blockquote> '''MISTERX: Two integers, X and Y between 2 and 99 (My formalization of the given information)''' <syntaxhighlight lang="prolog">two_integers( X, Y ) :- between( 2, 98, X ), between( X, 99, Y ).</syntaxhighlight> He tells Susan the Sum of them and Peter their Product. Their task is to get the two original values without telling each other the numbers that Mister X told them. <blockquote>After some time Peter says: "I can't say definitively which are the original numbers."</blockquote> '''PETER1: There is more than one pair of factors giving Product''' <syntaxhighlight lang="prolog">property( peter1, Product ) :- \+ unique_factors( Product ).</syntaxhighlight> <blockquote>Then Susan responds: "Neither can I, but I knew that you couldn't know it." </blockquote> '''SUSAN1: The product of ''every'' pair of summands giving Sum has the property PETER1''' <syntaxhighlight lang="prolog">property( susan1, Sum ) :- forall( ordered_summands(Sum, X, Y), peter1(X * Y) ).</syntaxhighlight> <blockquote>Peter: "Really? So now I know the original numbers".</blockquote> '''PETER2: ''exactly one'' pair of factors giving Product gives a sum with the property SUSAN1''' <syntaxhighlight lang="prolog">property( peter2, Product ) :- unique_solution( (ordered_factors(Product, X, Y), susan1(X+Y)) ).</syntaxhighlight> <blockquote>Susan: "Now I know them too".</blockquote> '''SUSAN2: ''exactly one'' pair of summands giving Sum has a product with the property PETER2''' <syntaxhighlight lang="prolog">property( susan2, Sum ) :- unique_solution( (ordered_summands(Sum, X, Y), peter2(X * Y)) ).</syntaxhighlight> <blockquote>Question: What are the two numbers that Mister X thought of?</blockquote> '''Unique solution''' <syntaxhighlight lang="prolog">solve( X, Y ) :- unique_solution( mister_x(X, Y) ). mister_x( X, Y ) :- two_integers( X, Y ), Sum is X + Y, Product is X * Y, peter1( Product ), susan1( Sum ), peter2( Product ), susan2( Sum ).</syntaxhighlight> == Macros == <syntaxhighlight lang="prolog">peter1( Product ) :- lemma( peter1, Product ). peter2( Product ) :- lemma( peter2, Product ). susan1( Sum ) :- lemma( susan1, Sum ). susan2( Sum ) :- lemma( susan2, Sum ).</syntaxhighlight> == Lemmas == ====lemma( +Property, +Expression )==== holds wherever <var>Property</var> holds for <var>Expression</var>. Asserted facts are used to record successful (''positive'') or failed (''negative'') demonstrations. This saves recomputation without changing the meaning of the pure program. Although the use of side-effects is generally undesirable, the use of lemmas is justified when the alternative is to compromise performance or clarity. Using lemmas or tabling to cache results is three orders of magnitude faster than recalculating each property every time it is used. <syntaxhighlight lang="prolog">:- dynamic positive/2, negative/2. lemma( Name, Expression ) :- Value is Expression, ( positive( Value, Name ) -> true ; \+ negative( Value, Name ) -> ( property(Name, Value) -> assert( positive(Value, Name) ) ; otherwise -> assert( negative(Value, Name) ), fail ) ).</syntaxhighlight> == Supporting Predicates == ====ordered_summands( +Sum, ?X, ?Y )==== when <var>X</var> &le; <var>Y</var> and Sum = <var>X</var>+<var>Y</var>. NB: Since <var>X</var>&le;<var>Y</var> it follows that <var>X</var> &le; <var>Sum</var>/2. <syntaxhighlight lang="prolog">ordered_summands( Z, X, Y ) :- Half is Z//2, between( 2, Half, X ), Y is Z - X, between( X, 98, Y ).</syntaxhighlight> ====ordered_factors( +Product, ?X, ?Y )==== when <var>X</var> &le; <var>Y</var> and <var>Product</var> = <var>X</var> &times; <var>Y</var>. NB: Since <var>X</var>&le;<var>Y</var> it follows that <var>X</var> &le; &radic;<var>Product</var>. <syntaxhighlight lang="prolog">ordered_factors( Z, X, Y ) :- integer_sqrt( Z, SqrtZ ), between( 2, SqrtZ, X ), Y is Z // X, between( X, 99, Y ), Z =:= X * Y.</syntaxhighlight> ====unique_factors( +Product )==== when <var>Product</var> has exactly one pair of factors. <syntaxhighlight lang="prolog">unique_factors( Product ) :- ordered_factors( Product, X, _Y ), \+ (ordered_factors(Product, X1, _Y1), X1 =\= X).</syntaxhighlight> ====integer_sqrt( +N, ?Sqrt )==== when <var>Sqrt</var>² &le; <var>N</var> and (<var>Sqrt</var>+1)² &ge; <var>N</var>. <syntaxhighlight lang="prolog">integer_sqrt( N, Sqrt ) :- Float is N * 1.0, sqrt( Float, FSqrt ), Sqrt is integer(FSqrt).</syntaxhighlight> Load a small library of [[Puzzle Utilities]]. <syntaxhighlight lang="prolog">:- ensure_loaded( misc ).</syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/download/mister_x.txt here]. == Result == This program finds X and Y as '''4''' and '''13'''. == Tabling == Using tabling, rather than explicit lemmas, can simplify code. [https://binding-time.co.uk/download/xsb_mister_x.txt A version adapted for XSB Prolog is available here.] 0fd3c5dccc919cede8da448d407f6c150ecdbfd1 88 69 2015-01-20T22:51:33Z John 2 Fix broken link wikitext text/x-wiki __NOTOC__ Although this problem has a straightforward solution, it does demonstrate the value of "Prolog thinking" in understanding the problem, which relates to nondeterminism -- especially "don't know" nondeterminism, and an appropriate use of "lemmas". == Problem: == [http://groups.google.com/group/de.comp.lang.java/msg/12cb7c2083cde4f8 Problem as posted to comp.lang.prolog] by Thorsten Seelend. Also known as [http://en.wikipedia.org/wiki/Impossible_Puzzle Hans Freudenthal's Impossible Puzzle]. <blockquote>Mister X thinks about two integers between 1 and 100 excluding: </blockquote> '''MISTERX: Two integers, X and Y between 2 and 99 (My formalization of the given information)''' <syntaxhighlight lang="prolog">two_integers( X, Y ) :- between( 2, 98, X ), between( X, 99, Y ).</syntaxhighlight> He tells Susan the Sum of them and Peter their Product. Their task is to get the two original values without telling each other the numbers that Mister X told them. <blockquote>After some time Peter says: "I can't say definitively which are the original numbers."</blockquote> '''PETER1: There is more than one pair of factors giving Product''' <syntaxhighlight lang="prolog">property( peter1, Product ) :- \+ unique_factors( Product ).</syntaxhighlight> <blockquote>Then Susan responds: "Neither can I, but I knew that you couldn't know it." </blockquote> '''SUSAN1: The product of ''every'' pair of summands giving Sum has the property PETER1''' <syntaxhighlight lang="prolog">property( susan1, Sum ) :- forall( ordered_summands(Sum, X, Y), peter1(X * Y) ).</syntaxhighlight> <blockquote>Peter: "Really? So now I know the original numbers".</blockquote> '''PETER2: ''exactly one'' pair of factors giving Product gives a sum with the property SUSAN1''' <syntaxhighlight lang="prolog">property( peter2, Product ) :- unique_solution( (ordered_factors(Product, X, Y), susan1(X+Y)) ).</syntaxhighlight> <blockquote>Susan: "Now I know them too".</blockquote> '''SUSAN2: ''exactly one'' pair of summands giving Sum has a product with the property PETER2''' <syntaxhighlight lang="prolog">property( susan2, Sum ) :- unique_solution( (ordered_summands(Sum, X, Y), peter2(X * Y)) ).</syntaxhighlight> <blockquote>Question: What are the two numbers that Mister X thought of?</blockquote> '''Unique solution''' <syntaxhighlight lang="prolog">solve( X, Y ) :- unique_solution( mister_x(X, Y) ). mister_x( X, Y ) :- two_integers( X, Y ), Sum is X + Y, Product is X * Y, peter1( Product ), susan1( Sum ), peter2( Product ), susan2( Sum ).</syntaxhighlight> == Macros == <syntaxhighlight lang="prolog">peter1( Product ) :- lemma( peter1, Product ). peter2( Product ) :- lemma( peter2, Product ). susan1( Sum ) :- lemma( susan1, Sum ). susan2( Sum ) :- lemma( susan2, Sum ).</syntaxhighlight> == Lemmas == ====lemma( +Property, +Expression )==== holds wherever <var>Property</var> holds for <var>Expression</var>. Asserted facts are used to record successful (''positive'') or failed (''negative'') demonstrations. This saves recomputation without changing the meaning of the pure program. Although the use of side-effects is generally undesirable, the use of lemmas is justified when the alternative is to compromise performance or clarity. Using lemmas or tabling to cache results is three orders of magnitude faster than recalculating each property every time it is used. <syntaxhighlight lang="prolog">:- dynamic positive/2, negative/2. lemma( Name, Expression ) :- Value is Expression, ( positive( Value, Name ) -> true ; \+ negative( Value, Name ) -> ( property(Name, Value) -> assert( positive(Value, Name) ) ; otherwise -> assert( negative(Value, Name) ), fail ) ).</syntaxhighlight> == Supporting Predicates == ====ordered_summands( +Sum, ?X, ?Y )==== when <var>X</var> &le; <var>Y</var> and Sum = <var>X</var>+<var>Y</var>. NB: Since <var>X</var>&le;<var>Y</var> it follows that <var>X</var> &le; <var>Sum</var>/2. <syntaxhighlight lang="prolog">ordered_summands( Z, X, Y ) :- Half is Z//2, between( 2, Half, X ), Y is Z - X, between( X, 98, Y ).</syntaxhighlight> ====ordered_factors( +Product, ?X, ?Y )==== when <var>X</var> &le; <var>Y</var> and <var>Product</var> = <var>X</var> &times; <var>Y</var>. NB: Since <var>X</var>&le;<var>Y</var> it follows that <var>X</var> &le; &radic;<var>Product</var>. <syntaxhighlight lang="prolog">ordered_factors( Z, X, Y ) :- integer_sqrt( Z, SqrtZ ), between( 2, SqrtZ, X ), Y is Z // X, between( X, 99, Y ), Z =:= X * Y.</syntaxhighlight> ====unique_factors( +Product )==== when <var>Product</var> has exactly one pair of factors. <syntaxhighlight lang="prolog">unique_factors( Product ) :- ordered_factors( Product, X, _Y ), \+ (ordered_factors(Product, X1, _Y1), X1 =\= X).</syntaxhighlight> ====integer_sqrt( +N, ?Sqrt )==== when <var>Sqrt</var>² &le; <var>N</var> and (<var>Sqrt</var>+1)² &ge; <var>N</var>. <syntaxhighlight lang="prolog">integer_sqrt( N, Sqrt ) :- Float is N * 1.0, sqrt( Float, FSqrt ), Sqrt is integer(FSqrt).</syntaxhighlight> Load a small library of [[Puzzle Utilities]]. <syntaxhighlight lang="prolog">:- ensure_loaded( misc ).</syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/download/mister_x.txt here]. == Result == This program finds X and Y as '''4''' and '''13'''. == Tabling == Using tabling, rather than explicit lemmas, can simplify code. [https://binding-time.co.uk/download/xsb_mister_x.txt A version adapted for XSB Prolog is available here.] 58d221b3a7bef427cc28cbfa02598354ffded506 89 88 2015-01-21T22:53:56Z John 2 Interwiki link wikitext text/x-wiki __NOTOC__ Although this problem has a straightforward solution, it does demonstrate the value of "Prolog thinking" in understanding the problem, which relates to nondeterminism -- especially "don't know" nondeterminism, and an appropriate use of "lemmas". == Problem: == [http://groups.google.com/group/de.comp.lang.java/msg/12cb7c2083cde4f8 Problem as posted to comp.lang.prolog] by Thorsten Seelend. Also known as Hans Freudenthal's [[wikipedia:Impossible Puzzle|Impossible Puzzle]]. <blockquote>Mister X thinks about two integers between 1 and 100 excluding: </blockquote> '''MISTERX: Two integers, X and Y between 2 and 99 (My formalization of the given information)''' <syntaxhighlight lang="prolog">two_integers( X, Y ) :- between( 2, 98, X ), between( X, 99, Y ).</syntaxhighlight> He tells Susan the Sum of them and Peter their Product. Their task is to get the two original values without telling each other the numbers that Mister X told them. <blockquote>After some time Peter says: "I can't say definitively which are the original numbers."</blockquote> '''PETER1: There is more than one pair of factors giving Product''' <syntaxhighlight lang="prolog">property( peter1, Product ) :- \+ unique_factors( Product ).</syntaxhighlight> <blockquote>Then Susan responds: "Neither can I, but I knew that you couldn't know it." </blockquote> '''SUSAN1: The product of ''every'' pair of summands giving Sum has the property PETER1''' <syntaxhighlight lang="prolog">property( susan1, Sum ) :- forall( ordered_summands(Sum, X, Y), peter1(X * Y) ).</syntaxhighlight> <blockquote>Peter: "Really? So now I know the original numbers".</blockquote> '''PETER2: ''exactly one'' pair of factors giving Product gives a sum with the property SUSAN1''' <syntaxhighlight lang="prolog">property( peter2, Product ) :- unique_solution( (ordered_factors(Product, X, Y), susan1(X+Y)) ).</syntaxhighlight> <blockquote>Susan: "Now I know them too".</blockquote> '''SUSAN2: ''exactly one'' pair of summands giving Sum has a product with the property PETER2''' <syntaxhighlight lang="prolog">property( susan2, Sum ) :- unique_solution( (ordered_summands(Sum, X, Y), peter2(X * Y)) ).</syntaxhighlight> <blockquote>Question: What are the two numbers that Mister X thought of?</blockquote> '''Unique solution''' <syntaxhighlight lang="prolog">solve( X, Y ) :- unique_solution( mister_x(X, Y) ). mister_x( X, Y ) :- two_integers( X, Y ), Sum is X + Y, Product is X * Y, peter1( Product ), susan1( Sum ), peter2( Product ), susan2( Sum ).</syntaxhighlight> == Macros == <syntaxhighlight lang="prolog">peter1( Product ) :- lemma( peter1, Product ). peter2( Product ) :- lemma( peter2, Product ). susan1( Sum ) :- lemma( susan1, Sum ). susan2( Sum ) :- lemma( susan2, Sum ).</syntaxhighlight> == Lemmas == ====lemma( +Property, +Expression )==== holds wherever <var>Property</var> holds for <var>Expression</var>. Asserted facts are used to record successful (''positive'') or failed (''negative'') demonstrations. This saves recomputation without changing the meaning of the pure program. Although the use of side-effects is generally undesirable, the use of lemmas is justified when the alternative is to compromise performance or clarity. Using lemmas or tabling to cache results is three orders of magnitude faster than recalculating each property every time it is used. <syntaxhighlight lang="prolog">:- dynamic positive/2, negative/2. lemma( Name, Expression ) :- Value is Expression, ( positive( Value, Name ) -> true ; \+ negative( Value, Name ) -> ( property(Name, Value) -> assert( positive(Value, Name) ) ; otherwise -> assert( negative(Value, Name) ), fail ) ).</syntaxhighlight> == Supporting Predicates == ====ordered_summands( +Sum, ?X, ?Y )==== when <var>X</var> &le; <var>Y</var> and Sum = <var>X</var>+<var>Y</var>. NB: Since <var>X</var>&le;<var>Y</var> it follows that <var>X</var> &le; <var>Sum</var>/2. <syntaxhighlight lang="prolog">ordered_summands( Z, X, Y ) :- Half is Z//2, between( 2, Half, X ), Y is Z - X, between( X, 98, Y ).</syntaxhighlight> ====ordered_factors( +Product, ?X, ?Y )==== when <var>X</var> &le; <var>Y</var> and <var>Product</var> = <var>X</var> &times; <var>Y</var>. NB: Since <var>X</var>&le;<var>Y</var> it follows that <var>X</var> &le; &radic;<var>Product</var>. <syntaxhighlight lang="prolog">ordered_factors( Z, X, Y ) :- integer_sqrt( Z, SqrtZ ), between( 2, SqrtZ, X ), Y is Z // X, between( X, 99, Y ), Z =:= X * Y.</syntaxhighlight> ====unique_factors( +Product )==== when <var>Product</var> has exactly one pair of factors. <syntaxhighlight lang="prolog">unique_factors( Product ) :- ordered_factors( Product, X, _Y ), \+ (ordered_factors(Product, X1, _Y1), X1 =\= X).</syntaxhighlight> ====integer_sqrt( +N, ?Sqrt )==== when <var>Sqrt</var>² &le; <var>N</var> and (<var>Sqrt</var>+1)² &ge; <var>N</var>. <syntaxhighlight lang="prolog">integer_sqrt( N, Sqrt ) :- Float is N * 1.0, sqrt( Float, FSqrt ), Sqrt is integer(FSqrt).</syntaxhighlight> Load a small library of [[Puzzle Utilities]]. <syntaxhighlight lang="prolog">:- ensure_loaded( misc ).</syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/download/mister_x.txt here]. == Result == This program finds X and Y as '''4''' and '''13'''. == Tabling == Using tabling, rather than explicit lemmas, can simplify code. [https://binding-time.co.uk/download/xsb_mister_x.txt A version adapted for XSB Prolog is available here.] 1c51b25c53c74df30a5bfbed1275cbafc4aa9055 92 89 2015-04-24T15:44:41Z John 2 /* lemma( +Property, +Expression ) */ wikitext text/x-wiki __NOTOC__ Although this problem has a straightforward solution, it does demonstrate the value of "Prolog thinking" in understanding the problem, which relates to nondeterminism -- especially "don't know" nondeterminism, and an appropriate use of "lemmas". == Problem: == [http://groups.google.com/group/de.comp.lang.java/msg/12cb7c2083cde4f8 Problem as posted to comp.lang.prolog] by Thorsten Seelend. Also known as Hans Freudenthal's [[wikipedia:Impossible Puzzle|Impossible Puzzle]]. <blockquote>Mister X thinks about two integers between 1 and 100 excluding: </blockquote> '''MISTERX: Two integers, X and Y between 2 and 99 (My formalization of the given information)''' <syntaxhighlight lang="prolog">two_integers( X, Y ) :- between( 2, 98, X ), between( X, 99, Y ).</syntaxhighlight> He tells Susan the Sum of them and Peter their Product. Their task is to get the two original values without telling each other the numbers that Mister X told them. <blockquote>After some time Peter says: "I can't say definitively which are the original numbers."</blockquote> '''PETER1: There is more than one pair of factors giving Product''' <syntaxhighlight lang="prolog">property( peter1, Product ) :- \+ unique_factors( Product ).</syntaxhighlight> <blockquote>Then Susan responds: "Neither can I, but I knew that you couldn't know it." </blockquote> '''SUSAN1: The product of ''every'' pair of summands giving Sum has the property PETER1''' <syntaxhighlight lang="prolog">property( susan1, Sum ) :- forall( ordered_summands(Sum, X, Y), peter1(X * Y) ).</syntaxhighlight> <blockquote>Peter: "Really? So now I know the original numbers".</blockquote> '''PETER2: ''exactly one'' pair of factors giving Product gives a sum with the property SUSAN1''' <syntaxhighlight lang="prolog">property( peter2, Product ) :- unique_solution( (ordered_factors(Product, X, Y), susan1(X+Y)) ).</syntaxhighlight> <blockquote>Susan: "Now I know them too".</blockquote> '''SUSAN2: ''exactly one'' pair of summands giving Sum has a product with the property PETER2''' <syntaxhighlight lang="prolog">property( susan2, Sum ) :- unique_solution( (ordered_summands(Sum, X, Y), peter2(X * Y)) ).</syntaxhighlight> <blockquote>Question: What are the two numbers that Mister X thought of?</blockquote> '''Unique solution''' <syntaxhighlight lang="prolog">solve( X, Y ) :- unique_solution( mister_x(X, Y) ). mister_x( X, Y ) :- two_integers( X, Y ), Sum is X + Y, Product is X * Y, peter1( Product ), susan1( Sum ), peter2( Product ), susan2( Sum ).</syntaxhighlight> == Macros == <syntaxhighlight lang="prolog">peter1( Product ) :- lemma( peter1, Product ). peter2( Product ) :- lemma( peter2, Product ). susan1( Sum ) :- lemma( susan1, Sum ). susan2( Sum ) :- lemma( susan2, Sum ).</syntaxhighlight> == Lemmas == ====lemma( +Property, +Expression )==== holds wherever <var>Property</var> holds for <var>Expression</var>. Asserted facts are used to record successful (''positive'') or failed (''negative'') demonstrations. This saves recomputation without changing the meaning of the pure program. Although the use of side-effects is generally undesirable, the use of lemmas is justified when the alternative is to compromise performance or clarity. Using lemmas or tabling to cache results is an order of magnitude faster than recalculating each property every time it is used. <syntaxhighlight lang="prolog">:- dynamic positive/2, negative/2. lemma( Name, Expression ) :- Value is Expression, ( positive( Value, Name ) -> true ; \+ negative( Value, Name ) -> ( property(Name, Value) -> assert( positive(Value, Name) ) ; otherwise -> assert( negative(Value, Name) ), fail ) ).</syntaxhighlight> == Supporting Predicates == ====ordered_summands( +Sum, ?X, ?Y )==== when <var>X</var> &le; <var>Y</var> and Sum = <var>X</var>+<var>Y</var>. NB: Since <var>X</var>&le;<var>Y</var> it follows that <var>X</var> &le; <var>Sum</var>/2. <syntaxhighlight lang="prolog">ordered_summands( Z, X, Y ) :- Half is Z//2, between( 2, Half, X ), Y is Z - X, between( X, 98, Y ).</syntaxhighlight> ====ordered_factors( +Product, ?X, ?Y )==== when <var>X</var> &le; <var>Y</var> and <var>Product</var> = <var>X</var> &times; <var>Y</var>. NB: Since <var>X</var>&le;<var>Y</var> it follows that <var>X</var> &le; &radic;<var>Product</var>. <syntaxhighlight lang="prolog">ordered_factors( Z, X, Y ) :- integer_sqrt( Z, SqrtZ ), between( 2, SqrtZ, X ), Y is Z // X, between( X, 99, Y ), Z =:= X * Y.</syntaxhighlight> ====unique_factors( +Product )==== when <var>Product</var> has exactly one pair of factors. <syntaxhighlight lang="prolog">unique_factors( Product ) :- ordered_factors( Product, X, _Y ), \+ (ordered_factors(Product, X1, _Y1), X1 =\= X).</syntaxhighlight> ====integer_sqrt( +N, ?Sqrt )==== when <var>Sqrt</var>² &le; <var>N</var> and (<var>Sqrt</var>+1)² &ge; <var>N</var>. <syntaxhighlight lang="prolog">integer_sqrt( N, Sqrt ) :- Float is N * 1.0, sqrt( Float, FSqrt ), Sqrt is integer(FSqrt).</syntaxhighlight> Load a small library of [[Puzzle Utilities]]. <syntaxhighlight lang="prolog">:- ensure_loaded( misc ).</syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/download/mister_x.txt here]. == Result == This program finds X and Y as '''4''' and '''13'''. == Tabling == Using tabling, rather than explicit lemmas, can simplify code. [https://binding-time.co.uk/download/xsb_mister_x.txt A version adapted for XSB Prolog is available here.] 9828ec0492435718f81265390bc486748ab50d4c 94 92 2015-04-24T19:52:29Z John 2 /* integer_sqrt( +N, ?Sqrt ) */ wikitext text/x-wiki __NOTOC__ Although this problem has a straightforward solution, it does demonstrate the value of "Prolog thinking" in understanding the problem, which relates to nondeterminism -- especially "don't know" nondeterminism, and an appropriate use of "lemmas". == Problem: == [http://groups.google.com/group/de.comp.lang.java/msg/12cb7c2083cde4f8 Problem as posted to comp.lang.prolog] by Thorsten Seelend. Also known as Hans Freudenthal's [[wikipedia:Impossible Puzzle|Impossible Puzzle]]. <blockquote>Mister X thinks about two integers between 1 and 100 excluding: </blockquote> '''MISTERX: Two integers, X and Y between 2 and 99 (My formalization of the given information)''' <syntaxhighlight lang="prolog">two_integers( X, Y ) :- between( 2, 98, X ), between( X, 99, Y ).</syntaxhighlight> He tells Susan the Sum of them and Peter their Product. Their task is to get the two original values without telling each other the numbers that Mister X told them. <blockquote>After some time Peter says: "I can't say definitively which are the original numbers."</blockquote> '''PETER1: There is more than one pair of factors giving Product''' <syntaxhighlight lang="prolog">property( peter1, Product ) :- \+ unique_factors( Product ).</syntaxhighlight> <blockquote>Then Susan responds: "Neither can I, but I knew that you couldn't know it." </blockquote> '''SUSAN1: The product of ''every'' pair of summands giving Sum has the property PETER1''' <syntaxhighlight lang="prolog">property( susan1, Sum ) :- forall( ordered_summands(Sum, X, Y), peter1(X * Y) ).</syntaxhighlight> <blockquote>Peter: "Really? So now I know the original numbers".</blockquote> '''PETER2: ''exactly one'' pair of factors giving Product gives a sum with the property SUSAN1''' <syntaxhighlight lang="prolog">property( peter2, Product ) :- unique_solution( (ordered_factors(Product, X, Y), susan1(X+Y)) ).</syntaxhighlight> <blockquote>Susan: "Now I know them too".</blockquote> '''SUSAN2: ''exactly one'' pair of summands giving Sum has a product with the property PETER2''' <syntaxhighlight lang="prolog">property( susan2, Sum ) :- unique_solution( (ordered_summands(Sum, X, Y), peter2(X * Y)) ).</syntaxhighlight> <blockquote>Question: What are the two numbers that Mister X thought of?</blockquote> '''Unique solution''' <syntaxhighlight lang="prolog">solve( X, Y ) :- unique_solution( mister_x(X, Y) ). mister_x( X, Y ) :- two_integers( X, Y ), Sum is X + Y, Product is X * Y, peter1( Product ), susan1( Sum ), peter2( Product ), susan2( Sum ).</syntaxhighlight> == Macros == <syntaxhighlight lang="prolog">peter1( Product ) :- lemma( peter1, Product ). peter2( Product ) :- lemma( peter2, Product ). susan1( Sum ) :- lemma( susan1, Sum ). susan2( Sum ) :- lemma( susan2, Sum ).</syntaxhighlight> == Lemmas == ====lemma( +Property, +Expression )==== holds wherever <var>Property</var> holds for <var>Expression</var>. Asserted facts are used to record successful (''positive'') or failed (''negative'') demonstrations. This saves recomputation without changing the meaning of the pure program. Although the use of side-effects is generally undesirable, the use of lemmas is justified when the alternative is to compromise performance or clarity. Using lemmas or tabling to cache results is an order of magnitude faster than recalculating each property every time it is used. <syntaxhighlight lang="prolog">:- dynamic positive/2, negative/2. lemma( Name, Expression ) :- Value is Expression, ( positive( Value, Name ) -> true ; \+ negative( Value, Name ) -> ( property(Name, Value) -> assert( positive(Value, Name) ) ; otherwise -> assert( negative(Value, Name) ), fail ) ).</syntaxhighlight> == Supporting Predicates == ====ordered_summands( +Sum, ?X, ?Y )==== when <var>X</var> &le; <var>Y</var> and Sum = <var>X</var>+<var>Y</var>. NB: Since <var>X</var>&le;<var>Y</var> it follows that <var>X</var> &le; <var>Sum</var>/2. <syntaxhighlight lang="prolog">ordered_summands( Z, X, Y ) :- Half is Z//2, between( 2, Half, X ), Y is Z - X, between( X, 98, Y ).</syntaxhighlight> ====ordered_factors( +Product, ?X, ?Y )==== when <var>X</var> &le; <var>Y</var> and <var>Product</var> = <var>X</var> &times; <var>Y</var>. NB: Since <var>X</var>&le;<var>Y</var> it follows that <var>X</var> &le; &radic;<var>Product</var>. <syntaxhighlight lang="prolog">ordered_factors( Z, X, Y ) :- integer_sqrt( Z, SqrtZ ), between( 2, SqrtZ, X ), Y is Z // X, between( X, 99, Y ), Z =:= X * Y.</syntaxhighlight> ====unique_factors( +Product )==== when <var>Product</var> has exactly one pair of factors. <syntaxhighlight lang="prolog">unique_factors( Product ) :- ordered_factors( Product, X, _Y ), \+ (ordered_factors(Product, X1, _Y1), X1 =\= X).</syntaxhighlight> ====integer_sqrt( +N, ?Sqrt )==== when <var>Sqrt</var>² &le; <var>N</var> and (<var>Sqrt</var>+1)² &ge; <var>N</var>. <syntaxhighlight lang="prolog">integer_sqrt( N, Sqrt ) :- Float is N * 1.0, sqrt( Float, FSqrt ), Sqrt is integer(FSqrt).</syntaxhighlight> Load a small library of [[Puzzle Utilities]]. <syntaxhighlight lang="prolog"> :- ensure_loaded( misc ). </syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/download/mister_x.txt here]. == Result == This program finds X and Y as '''4''' and '''13'''. == Tabling == Using tabling, rather than explicit lemmas, can simplify code. [https://binding-time.co.uk/download/xsb_mister_x.txt A version adapted for XSB Prolog is available here.] 2081365c3878d3638438c5d461321843d47b40ec 95 94 2015-04-27T18:29:01Z John 2 wikitext text/x-wiki __NOTOC__ Although this problem has a straightforward solution, it does demonstrate the value of thinking declaratively in understanding the problem, which relates to "don't know" nondeterminism, and an appropriate use of "lemmas". == Problem: == [http://groups.google.com/group/de.comp.lang.java/msg/12cb7c2083cde4f8 Problem as posted to comp.lang.prolog] by Thorsten Seelend. Also known as Hans Freudenthal's [[wikipedia:Impossible Puzzle|Impossible Puzzle]]. <blockquote>Mister X thinks about two integers between 1 and 100 excluding: </blockquote> '''MISTERX: Two integers, X and Y between 2 and 99 (My formalization of the given information)''' <syntaxhighlight lang="prolog">two_integers( X, Y ) :- between( 2, 98, X ), between( X, 99, Y ).</syntaxhighlight> He tells Susan the Sum of them and Peter their Product. Their task is to get the two original values without telling each other the numbers that Mister X told them. <blockquote>After some time Peter says: "I can't say definitively which are the original numbers."</blockquote> '''PETER1: There is more than one pair of factors giving Product''' <syntaxhighlight lang="prolog">property( peter1, Product ) :- \+ unique_factors( Product ).</syntaxhighlight> <blockquote>Then Susan responds: "Neither can I, but I knew that you couldn't know it." </blockquote> '''SUSAN1: The product of ''every'' pair of summands giving Sum has the property PETER1''' <syntaxhighlight lang="prolog">property( susan1, Sum ) :- forall( ordered_summands(Sum, X, Y), peter1(X * Y) ).</syntaxhighlight> <blockquote>Peter: "Really? So now I know the original numbers".</blockquote> '''PETER2: ''exactly one'' pair of factors giving Product gives a sum with the property SUSAN1''' <syntaxhighlight lang="prolog">property( peter2, Product ) :- unique_solution( (ordered_factors(Product, X, Y), susan1(X+Y)) ).</syntaxhighlight> <blockquote>Susan: "Now I know them too".</blockquote> '''SUSAN2: ''exactly one'' pair of summands giving Sum has a product with the property PETER2''' <syntaxhighlight lang="prolog">property( susan2, Sum ) :- unique_solution( (ordered_summands(Sum, X, Y), peter2(X * Y)) ).</syntaxhighlight> <blockquote>Question: What are the two numbers that Mister X thought of?</blockquote> '''Unique solution''' <syntaxhighlight lang="prolog">solve( X, Y ) :- unique_solution( mister_x(X, Y) ). mister_x( X, Y ) :- two_integers( X, Y ), Sum is X + Y, Product is X * Y, peter1( Product ), susan1( Sum ), peter2( Product ), susan2( Sum ).</syntaxhighlight> == Macros == <syntaxhighlight lang="prolog">peter1( Product ) :- lemma( peter1, Product ). peter2( Product ) :- lemma( peter2, Product ). susan1( Sum ) :- lemma( susan1, Sum ). susan2( Sum ) :- lemma( susan2, Sum ).</syntaxhighlight> == Lemmas == ====lemma( +Property, +Expression )==== holds wherever <var>Property</var> holds for <var>Expression</var>. Asserted facts are used to record successful (''positive'') or failed (''negative'') demonstrations. This saves recomputation without changing the meaning of the pure program. Although the use of side-effects is generally undesirable, the use of lemmas is justified when the alternative is to compromise performance or clarity. Using lemmas or tabling to cache results is an order of magnitude faster than recalculating each property every time it is used. <syntaxhighlight lang="prolog">:- dynamic positive/2, negative/2. lemma( Name, Expression ) :- Value is Expression, ( positive( Value, Name ) -> true ; \+ negative( Value, Name ) -> ( property(Name, Value) -> assert( positive(Value, Name) ) ; otherwise -> assert( negative(Value, Name) ), fail ) ).</syntaxhighlight> == Supporting Predicates == ====ordered_summands( +Sum, ?X, ?Y )==== when <var>X</var> &le; <var>Y</var> and Sum = <var>X</var>+<var>Y</var>. NB: Since <var>X</var>&le;<var>Y</var> it follows that <var>X</var> &le; <var>Sum</var>/2. <syntaxhighlight lang="prolog">ordered_summands( Z, X, Y ) :- Half is Z//2, between( 2, Half, X ), Y is Z - X, between( X, 98, Y ).</syntaxhighlight> ====ordered_factors( +Product, ?X, ?Y )==== when <var>X</var> &le; <var>Y</var> and <var>Product</var> = <var>X</var> &times; <var>Y</var>. NB: Since <var>X</var>&le;<var>Y</var> it follows that <var>X</var> &le; &radic;<var>Product</var>. <syntaxhighlight lang="prolog">ordered_factors( Z, X, Y ) :- integer_sqrt( Z, SqrtZ ), between( 2, SqrtZ, X ), Y is Z // X, between( X, 99, Y ), Z =:= X * Y.</syntaxhighlight> ====unique_factors( +Product )==== when <var>Product</var> has exactly one pair of factors. <syntaxhighlight lang="prolog">unique_factors( Product ) :- ordered_factors( Product, X, _Y ), \+ (ordered_factors(Product, X1, _Y1), X1 =\= X).</syntaxhighlight> ====integer_sqrt( +N, ?Sqrt )==== when <var>Sqrt</var>² &le; <var>N</var> and (<var>Sqrt</var>+1)² &ge; <var>N</var>. <syntaxhighlight lang="prolog">integer_sqrt( N, Sqrt ) :- Float is N * 1.0, sqrt( Float, FSqrt ), Sqrt is integer(FSqrt).</syntaxhighlight> Load a small library of [[Puzzle Utilities]]. <syntaxhighlight lang="prolog"> :- ensure_loaded( misc ). </syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/download/mister_x.txt here]. == Result == This program finds X and Y as '''4''' and '''13'''. == Tabling == Using tabling, rather than explicit lemmas, can simplify code. [https://binding-time.co.uk/download/xsb_mister_x.txt A version adapted for XSB Prolog is available here.] efcc2d78a878ccccedca920ab232d5e453d64008 96 95 2015-04-29T09:45:38Z John 2 /* Problem: */ wikitext text/x-wiki __NOTOC__ Although this problem has a straightforward solution, it does demonstrate the value of thinking declaratively in understanding the problem, which relates to "don't know" nondeterminism, and an appropriate use of "lemmas". == Problem: == [http://groups.google.com/group/de.comp.lang.java/msg/12cb7c2083cde4f8 Problem as posted to comp.lang.prolog] by Thorsten Seelend. Also known as Hans Freudenthal's [[wikipedia:Impossible Puzzle|Impossible Puzzle]]. <blockquote>Mister X thinks about two integers between 1 and 100 excluding: </blockquote> =====MISTERX: Two integers, X and Y between 2 and 99 (My formalization of the given information)===== <syntaxhighlight lang="prolog">two_integers( X, Y ) :- between( 2, 98, X ), between( X, 99, Y ).</syntaxhighlight> He tells Susan the Sum of them and Peter their Product. Their task is to get the two original values without telling each other the numbers that Mister X told them. <blockquote>After some time Peter says: "I can't say definitively which are the original numbers."</blockquote> =====PETER1: There is more than one pair of factors giving Product===== <syntaxhighlight lang="prolog">property( peter1, Product ) :- \+ unique_factors( Product ).</syntaxhighlight> <blockquote>Then Susan responds: "Neither can I, but I knew that you couldn't know it." </blockquote> =====SUSAN1: The product of ''every'' pair of summands giving Sum has the property PETER1===== <syntaxhighlight lang="prolog">property( susan1, Sum ) :- forall( ordered_summands(Sum, X, Y), peter1(X * Y) ).</syntaxhighlight> <blockquote>Peter: "Really? So now I know the original numbers".</blockquote> =====PETER2: ''exactly one'' pair of factors giving Product gives a sum with the property SUSAN1===== <syntaxhighlight lang="prolog">property( peter2, Product ) :- unique_solution( (ordered_factors(Product, X, Y), susan1(X+Y)) ).</syntaxhighlight> <blockquote>Susan: "Now I know them too".</blockquote> =====SUSAN2: ''exactly one'' pair of summands giving Sum has a product with the property PETER2===== <syntaxhighlight lang="prolog">property( susan2, Sum ) :- unique_solution( (ordered_summands(Sum, X, Y), peter2(X * Y)) ).</syntaxhighlight> <blockquote>Question: What are the two numbers that Mister X thought of?</blockquote> =====Unique solution===== <syntaxhighlight lang="prolog">solve( X, Y ) :- unique_solution( mister_x(X, Y) ). mister_x( X, Y ) :- two_integers( X, Y ), Sum is X + Y, Product is X * Y, peter1( Product ), susan1( Sum ), peter2( Product ), susan2( Sum ).</syntaxhighlight> == Macros == <syntaxhighlight lang="prolog">peter1( Product ) :- lemma( peter1, Product ). peter2( Product ) :- lemma( peter2, Product ). susan1( Sum ) :- lemma( susan1, Sum ). susan2( Sum ) :- lemma( susan2, Sum ).</syntaxhighlight> == Lemmas == ====lemma( +Property, +Expression )==== holds wherever <var>Property</var> holds for <var>Expression</var>. Asserted facts are used to record successful (''positive'') or failed (''negative'') demonstrations. This saves recomputation without changing the meaning of the pure program. Although the use of side-effects is generally undesirable, the use of lemmas is justified when the alternative is to compromise performance or clarity. Using lemmas or tabling to cache results is an order of magnitude faster than recalculating each property every time it is used. <syntaxhighlight lang="prolog">:- dynamic positive/2, negative/2. lemma( Name, Expression ) :- Value is Expression, ( positive( Value, Name ) -> true ; \+ negative( Value, Name ) -> ( property(Name, Value) -> assert( positive(Value, Name) ) ; otherwise -> assert( negative(Value, Name) ), fail ) ).</syntaxhighlight> == Supporting Predicates == ====ordered_summands( +Sum, ?X, ?Y )==== when <var>X</var> &le; <var>Y</var> and Sum = <var>X</var>+<var>Y</var>. NB: Since <var>X</var>&le;<var>Y</var> it follows that <var>X</var> &le; <var>Sum</var>/2. <syntaxhighlight lang="prolog">ordered_summands( Z, X, Y ) :- Half is Z//2, between( 2, Half, X ), Y is Z - X, between( X, 98, Y ).</syntaxhighlight> ====ordered_factors( +Product, ?X, ?Y )==== when <var>X</var> &le; <var>Y</var> and <var>Product</var> = <var>X</var> &times; <var>Y</var>. NB: Since <var>X</var>&le;<var>Y</var> it follows that <var>X</var> &le; &radic;<var>Product</var>. <syntaxhighlight lang="prolog">ordered_factors( Z, X, Y ) :- integer_sqrt( Z, SqrtZ ), between( 2, SqrtZ, X ), Y is Z // X, between( X, 99, Y ), Z =:= X * Y.</syntaxhighlight> ====unique_factors( +Product )==== when <var>Product</var> has exactly one pair of factors. <syntaxhighlight lang="prolog">unique_factors( Product ) :- ordered_factors( Product, X, _Y ), \+ (ordered_factors(Product, X1, _Y1), X1 =\= X).</syntaxhighlight> ====integer_sqrt( +N, ?Sqrt )==== when <var>Sqrt</var>² &le; <var>N</var> and (<var>Sqrt</var>+1)² &ge; <var>N</var>. <syntaxhighlight lang="prolog">integer_sqrt( N, Sqrt ) :- Float is N * 1.0, sqrt( Float, FSqrt ), Sqrt is integer(FSqrt).</syntaxhighlight> Load a small library of [[Puzzle Utilities]]. <syntaxhighlight lang="prolog"> :- ensure_loaded( misc ). </syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/download/mister_x.txt here]. == Result == This program finds X and Y as '''4''' and '''13'''. == Tabling == Using tabling, rather than explicit lemmas, can simplify code. [https://binding-time.co.uk/download/xsb_mister_x.txt A version adapted for XSB Prolog is available here.] 5ada174b1bed41d9a20c5116aa5693fcf1c67a5b 8 6 62 8 2013-12-27T20:38:16Z WikiSysop 1 wikitext text/x-wiki * navigation ** mainpage|mainpage-description ** randompage-url|randompage * SEARCH d8d6595951f1a5500094bbd4c42483e3f450dcfa 0 14 65 2014-01-01T20:24:11Z John 2 Created page with "__NOTOC__ <blockquote>Problem posted to [http://groups.google.com/group/comp.lang.prolog/msg/269130cea31106d2 comp.lang.prolog] by Paul Nothman: &quot;This problem was recentl..." wikitext text/x-wiki __NOTOC__ <blockquote>Problem posted to [http://groups.google.com/group/comp.lang.prolog/msg/269130cea31106d2 comp.lang.prolog] by Paul Nothman: &quot;This problem was recently in a Mathematics competition. Although I completed it through logic and mathematics, without the aid of a computer, I'm wondering if and how it could be answered using prolog.&quot; </blockquote> == Problem Statement == The problem is as follows: World theme park has seven attractions which are so far apart that there needs to be a network of monorails, called zoomtracks, to transport the patrons between attractions. There is exactly one zoomtrack between each pair of attractions. Each zoomtrack can only transport patrons in one direction. The network is constructed so that two friends can always meet at a third attraction after exactly one trip each from any two attractions. Hint: Each attraction leads to and is led to by 3 other attractions. There are 21 zoomtracks altogether. Find the entire configuration of the theme park given the following: (The first letter of each line is the attraction from which the zoomtrack comes and the one beside it is where the zoomtrack leads to). SU SO ST UO UN UP OT ON NP TU == Solution Overview == An interesting aspect of this puzzle is the given &quot;partial solution&quot;. What is its purpose? Is it supposed to help or hinder? In fact, the partial solution allows relatively naive methods to find the right answer in reasonable time. However, I've chosen to implement a method that is not dependent on the partial solution. The key to this approach is the generation of the 'stations' data-structures, which '''may''' be partially instantiated with the given solution, before the search for a complete solution begins. The requirements of the problem are that each Attraction will have three destinations that can be reached by a single &quot;zoomtrack&quot;, and that every pair of Attractions must have a destination in common. This solution uses the insight that every pair of Attractions must have '''exactly one''' destination in common. ====zoom==== finds a solution and then prints it. <syntaxhighlight lang="prolog">zoom :- zoom_tracks( ZoomTracks ), print_zoom_tracks( ZoomTracks ).</syntaxhighlight> ====zoom_tracks( ?ZoomTracks )==== holds when <var>ZoomTracks</var> is a set of Attraction × Links × Destinations tuples, describing a valid configuration of zoomtracks, such that each pair of attractions has exactly one destination in common. The predicate network/2 always generates viable solutions, but a simple assertion is used to demonstrate that the solution is valid directly. <syntaxhighlight lang="prolog">zoom_tracks( ZoomTracks ) :- station_origin( Station, Attraction ), station_destinations( Station, Destinations ), length( Destinations, 3 ), findall( Station, attraction( Attraction ), ZoomTracks ), findall( [Dest,Dest,Dest], attraction( Dest ), PossibleDestinations ), unified_zoomtracks( ZoomTracks ), connections( ZoomTracks ), network( ZoomTracks, PossibleDestinations ), forall( pair_of_stations( ZoomTracks, Station1, Station2 ), friends_can_meet( Station1, Station2 ) ).</syntaxhighlight> ====unified_zoomtracks( +ZoomTracks )==== holds when <var>ZoomTracks</var> is a set of Attraction × Links × Destinations tuples such that each link between two Attractions is represented by a variable shared between the two attractions. In each tuple, the Link variable denoting the Attraction is bound to 'self'. <syntaxhighlight lang="prolog">unified_zoomtracks( ZoomTracks ) :- station_origin( First, Attraction1 ), station_origin( Second, Attraction2 ), findall( Attraction1-Attraction2, pair_of_stations(ZoomTracks, First, Second), Linkage ), unified_links( Linkage, ZoomTracks ).</syntaxhighlight> ====unified_links( +Linkage, +ZoomTracks )==== holds when <var>Linkage</var> is a list of Attraction1-Attraction2 pairs such that in <var>ZoomTracks</var>: * The link variables denoting Attraction1 for Attraction2 and vice versa are unified. * The link variables denoting Attraction1 for Attraction1 and Attraction2 for Attraction2 are bound to 'self'. <syntaxhighlight lang="prolog">unified_links( [], _ZoomTracks ). unified_links( [First-Second|Linkage], ZoomTracks ) :- station_origin( Station1, First ), station_links( Station1, Links1 ), station_origin( Station2, Second ), station_links( Station2, Links2 ), memberchk( Station1, ZoomTracks ), memberchk( Station2, ZoomTracks ), link_receiver( First, Links2, Receiver ), link_receiver( Second, Links1, Receiver ), link_receiver( First, Links1, self ), link_receiver( Second, Links2, self ), unified_links( Linkage, ZoomTracks ).</syntaxhighlight> ====connections( ?ZoomTracks )==== holds when the given connections have been applied to <var>ZoomTracks</var>. Note that this can be made vacuous without any significant effect on performance. <syntaxhighlight lang="prolog">connections( ZoomTracks ) :- connection( s, u, ZoomTracks ), connection( s, o, ZoomTracks ), connection( s, t, ZoomTracks ), connection( u, o, ZoomTracks ), connection( u, n, ZoomTracks ), connection( u, p, ZoomTracks ), connection( o, t, ZoomTracks ), connection( o, n, ZoomTracks ), connection( n, p, ZoomTracks ), connection( t, u, ZoomTracks ).</syntaxhighlight> ====connection( +Source, +Destination, +ZoomTracks )==== holds when <var>ZoomTracks</var> contains a connection from <var>Source</var> to <var>Destination</var>. <syntaxhighlight lang="prolog">connection( From, To, ZoomTracks ) :- station_origin( Station, From ), station_links( Station, Links ), station_destinations( Station, Destinations ), memberchk( Station, ZoomTracks ), memberchk( To, Destinations ), link_receiver( To, Links, To ).</syntaxhighlight> ====pair_of_stations( +ZoomTracks, ?Station1, ?Station2 )==== holds when <var>Station1</var> and <var>Station2</var> are distinct elements of <var>ZoomTracks</var>, avoiding redundant solutions. <syntaxhighlight lang="prolog">pair_of_stations( [Station1|ZoomTracks], Station1, Station2 ) :- member( Station2, ZoomTracks ). pair_of_stations( [_Station0|ZoomTracks], Station1, Station2 ) :- pair_of_stations( ZoomTracks, Station1, Station2 ).</syntaxhighlight> ====friends_can_meet( +Station1, +Station2 )==== holds when <var>Station1</var> and <var>Station2</var> have a common destination. <syntaxhighlight lang="prolog">friends_can_meet( Station1, Station2 ) :- station_destinations( Station1, Destinations1 ), station_destinations( Station2, Destinations2 ), member( MeetingPoint, Destinations1 ), member( MeetingPoint, Destinations2 ).</syntaxhighlight> ====network( +ZoomTracks, ?Destinations )==== holds when <var>ZoomTracks</var> is a set of Attraction &rarr; Destinations pairs describing a valid configuration of zoomtracks, such that each pair of attractions has exactly one destination in common. <var>Destinations</var> define the range of <var>ZoomTracks</var>. <syntaxhighlight lang="prolog">network( ZoomTracks, Destinations ) :- network1( ZoomTracks, Destinations, [] ). network1( [], Destinations, _Stations ) :- forall( member( Empty, Destinations ), Empty == [] ). network1( [Station|Stations], Destinations, Assigned ) :- destination_assignment( Station, Destinations, Destinations1 ), properly_connected( Station, Assigned ), network1( Stations, Destinations1, [Station|Assigned] ).</syntaxhighlight> ====destination_assignment( +Station, +Destinations, ?Destinations1 )==== holds when <var>Destinations1</var> is the difference of <var>Destinations</var> and the destinations of <var>Station</var>, which must not contain the origin of <var>Station</var>. <syntaxhighlight lang="prolog">destination_assignment( Station, Destinations0, Destinations1 ) :- station_destinations( Station, Destinations ), station_links( Station, Links ), matching( Destinations, Links, Destinations0, Destinations1 ).</syntaxhighlight> ====matching( +Destinations0, +Links, +Destinations1, ?Destinations2 )==== holds when <var>Destinations2</var> is the difference of <var>Destinations0</var> and <var>Destinations1</var>, and the <var>Links</var> variables corresponding to <var>Destinations0</var> are instantiated. <syntaxhighlight lang="prolog">matching( [], _Links, Destinations, Destinations ). matching( [Destination|Destinations], Links, Destinations0, [Rest|Destinations1] ) :- select( [Destination|Rest], Destinations0, Destinations2 ), link_receiver( Destination, Links, Destination ), matching( Destinations, Links, Destinations2, Destinations1 ).</syntaxhighlight> ====properly_connected( +Station, +Stations )==== holds when <var>Station</var> and each member of <var>Stations</var> have exactly one destination in common. <syntaxhighlight lang="prolog">properly_connected( Station, Stations ) :- station_destinations( Station, Destinations ), station_destinations( Station1, Destinations1 ), forall( member( Station1, Stations ), one_common_member( Destinations, Destinations1 ) ).</syntaxhighlight> ====one_common_member( ?Set0, ?Set1 )==== holds when <var>Set0</var> and <var>Set1</var> have exactly one common member. <syntaxhighlight lang="prolog">one_common_member( Set0, Set1 ) :- select( Member, Set0, Residue0 ), select( Member, Set1, Residue1 ), \+ common_member( Residue0, Residue1 ).</syntaxhighlight> ====common_member( ?Set0, ?Set1 )==== holds when <var>Set0</var> and <var>Set1</var> have a common member. <syntaxhighlight lang="prolog">common_member( Set0, Set1 ) :- member( Member, Set0 ), member( Member, Set1 ).</syntaxhighlight> === Data Abstraction === <syntaxhighlight lang="prolog">attraction( Name ) :- link_receiver( Name, _Links, _Value ). link_receiver( s, links( S,_U,_O,_N,_T,_P,_Q), S ). link_receiver( u, links(_S, U,_O,_N,_T,_P,_Q), U ). link_receiver( o, links(_S,_U, O,_N,_T,_P,_Q), O ). link_receiver( n, links(_S,_U,_O, N,_T,_P,_Q), N ). link_receiver( t, links(_S,_U,_O,_N, T,_P,_Q), T ). link_receiver( p, links(_S,_U,_O,_N,_T ,P,_Q), P ). link_receiver( q, links(_S,_U,_O,_N,_T,_P, Q), Q ). station_destinations( zoom(_Name, _Links, Destinations), Destinations ). station_links( zoom(_Name, Links, _Destinations), Links ). station_origin( zoom(Name, _Links, _Destinations), Name ).</syntaxhighlight> ==Utility Predicates== Load a small library of [[Puzzle Utilities]]. <syntaxhighlight lang="prolog"> :- ensure_loaded( misc ). </syntaxhighlight> ====print_zoom_tracks( +ZoomTracks )==== prints all the links in <var>ZoomTracks</var> as origin - destination pairs of stations. <syntaxhighlight lang="prolog">print_zoom_tracks( [] ). print_zoom_tracks( [ZoomTrack|ZoomTracks] ) :- station_origin( ZoomTrack, Origin ), station_destinations( ZoomTrack, Destinations ), print_zoom_track_links( Destinations, Origin ), print_zoom_tracks( ZoomTracks ). print_zoom_track_links( [], _Origin ). print_zoom_track_links( [Destination|Destinations], Origin ) :- format( '~w~w~n', [Origin,Destination] ), print_zoom_track_links( Destinations, Origin ).</syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/download/zoom_tracks.txt here]. ==Result== <pre class="Result">| ?- zoom. su so st uo un up ot on oq np nt ns tu tp tq pq ps po qs qu qn yes</pre> 812740e3b6b49a8c12b200752baff97e6ceb850d 0 15 66 2014-01-01T20:25:56Z John 2 Created page with "__NOTOC__ ==Problem Statement== <blockquote><div>Problem posted to [http://groups.google.com/group/comp.lang.prolog/msg/ba2b3c1fc8f73007 comp.lang.prolog] by Nimesh777@aol.com..." wikitext text/x-wiki __NOTOC__ ==Problem Statement== <blockquote><div>Problem posted to [http://groups.google.com/group/comp.lang.prolog/msg/ba2b3c1fc8f73007 comp.lang.prolog] by Nimesh777@aol.com</div> M has been murdered. A, B and C are suspects. * A says he is innocent, B was M's friend but C hated M. * B says that he was out of town on the day of the murder, besides he didn't even know M. * C says he is innocent but he saw A &amp; B with M just before the murder. Assuming that all except possibly the murderer are telling the truth, solve the crime. </blockquote> ==Solution== <blockquote cite=""> When you have eliminated the impossible, whatever remains, however improbable, must be the truth. <cite>[http://www.gutenberg.org/ebooks/2097 Sir Arthur Conan Doyle - The Sign of the Four]</cite> </blockquote> ==== solve_murder( ?Murderer ) ==== Solving the crime means finding the <var>Murderer</var>'s identity, such that the <var>Murderer</var>'s statement is the only one that is inconsistent with the statements of the other suspects. <syntaxhighlight lang="prolog">solve_murder( Murderer ) :- unique_solution( murderer( Murderer ) ).</syntaxhighlight> Firstly, the suspects' statements are formalized: <syntaxhighlight lang="prolog">statement( a ) --> [innocent(a),friend(b,m),hates(c,m)]. statement( b ) --> [alibi(b),not_know(b,m)]. statement( c ) --> [innocent(c),with(c,m),with(b,m),with(a,m)]. statements( [] ) --> []. statements( [Witness|Witnesses] ) --> statement( Witness ), statements( Witnesses ).</syntaxhighlight> Then we define mutual-exclusivity between assertions. <syntaxhighlight lang="prolog">mutually_exclusive( [friend(X,Y), hates(X,Y), not_know(X,Y)] ). mutually_exclusive( [innocent(X), guilty(X)] ). mutually_exclusive( [alibi(X), with(X,m)] ). mutually_exclusive( [alibi(X), with(m,X)] ). mutually_exclusive( [alibi(X), guilty(X)] ).</syntaxhighlight> The murderer is identified by showing that the statements of the other suspects (witnesses) are consistent with each other, and with the murderer being guilty. <syntaxhighlight lang="prolog">murderer( Murderer ) :- Suspects = [a,b,c], select( Murderer, Suspects, Witnesses ), phrase( statements(Witnesses), Assertions ), consistent( [guilty(Murderer)|Assertions] ).</syntaxhighlight> A set of assertions is consistent if no inconsistency can be found between any member and the rest of the set. <syntaxhighlight lang="prolog">consistent( Statements ) :- \+ inconsistent( Statements ).</syntaxhighlight> An assertion is inconsistent with a set of assertions if it is pairwise exclusive with a member of the set. <syntaxhighlight lang="prolog">inconsistent( [Assertion|Assertions] ) :- mutually_exclusive( Exclusive ), select( Assertion, Exclusive, Inconsistent ), member( Inconsistency, Inconsistent ), member( Inconsistency, Assertions ). inconsistent( [_Assertion|Assertions] ) :- inconsistent( Assertions ).</syntaxhighlight> Load a small library of [[Puzzle Utilities]]. <syntaxhighlight lang="prolog"> :- ensure_loaded( misc ). </syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/download/whodunit.txt here]. ==Result== <pre>?- solve_murder( Murderer ). Murderer = b</pre> 0959c7eae50173ea953b0cf6b0c206455dac2c09 67 66 2014-01-09T00:13:18Z John 2 /* solve_murder( ?Murderer ) */ wikitext text/x-wiki __NOTOC__ ==Problem Statement== <blockquote><div>Problem posted to [http://groups.google.com/group/comp.lang.prolog/msg/ba2b3c1fc8f73007 comp.lang.prolog] by Nimesh777@aol.com</div> M has been murdered. A, B and C are suspects. * A says he is innocent, B was M's friend but C hated M. * B says that he was out of town on the day of the murder, besides he didn't even know M. * C says he is innocent but he saw A &amp; B with M just before the murder. Assuming that all except possibly the murderer are telling the truth, solve the crime. </blockquote> ==Solution== <blockquote cite=""> When you have eliminated the impossible, whatever remains, however improbable, must be the truth. <cite>[http://www.gutenberg.org/ebooks/2097 Sir Arthur Conan Doyle - The Sign of the Four]</cite> </blockquote> ==== solve_murder( ?Murderer ) ==== Solving the crime means finding the <var>Murderer</var>'s identity, such that the <var>Murderer</var>'s statement is the only one that is inconsistent with the statements of the other suspects. <syntaxhighlight lang="prolog">solve_murder( Murderer ) :- unique_solution( murderer( Murderer ) ).</syntaxhighlight> Firstly, the suspects' statements are formalized: <syntaxhighlight lang="prolog">statement( a ) --> [innocent(a),friend(b,m),hates(c,m)]. statement( b ) --> [alibi(b),not_know(b,m)]. statement( c ) --> [innocent(c),with(c,m),with(b,m),with(a,m)]. statements( [] ) --> []. statements( [Witness|Witnesses] ) --> statement( Witness ), statements( Witnesses ).</syntaxhighlight> Then we define mutual-exclusivity between assertions. <syntaxhighlight lang="prolog">mutually_exclusive( [friend(X,Y), hates(X,Y), not_know(X,Y)] ). mutually_exclusive( [innocent(X), guilty(X)] ). mutually_exclusive( [alibi(X), with(X,m)] ). mutually_exclusive( [alibi(X), with(m,X)] ). mutually_exclusive( [alibi(X), guilty(X)] ).</syntaxhighlight> The murderer is identified by showing that the statements of the other suspects (witnesses) are consistent with each other, and with the murderer being guilty. <syntaxhighlight lang="prolog">murderer( Murderer ) :- Suspects = [a,b,c], select( Murderer, Suspects, Witnesses ), phrase( statements(Witnesses), Assertions ), consistent( [guilty(Murderer)|Assertions] ).</syntaxhighlight> A set of assertions is consistent if no inconsistency can be found between any member and the rest of the set. <syntaxhighlight lang="prolog">consistent( Statements ) :- \+ inconsistent( Statements ).</syntaxhighlight> An assertion is inconsistent with a set of assertions if it is pairwise exclusive with a member of the set. <syntaxhighlight lang="prolog">inconsistent( [Assertion|Assertions] ) :- mutually_exclusive( Exclusive ), select( Assertion, Exclusive, Inconsistent ), member( Inconsistency, Inconsistent ), member( Inconsistency, Assertions ). inconsistent( [_Assertion|Assertions] ) :- inconsistent( Assertions ).</syntaxhighlight> Load a small library of [[Puzzle Utilities]]. <syntaxhighlight lang="prolog"> :- ensure_loaded( misc ). </syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/download/whodunit.txt here]. ==Result== <pre>?- solve_murder( Murderer ). Murderer = b</pre> 94f6cb33c70dc06759b59dce833ba963dcaa6ee1 4 7 68 16 2014-01-24T21:48:09Z John 2 /* Why Wiki? */ wikitext text/x-wiki I am migrating my site to MediaWiki to make it easier to maintain. I hope that you like it. == Why Wiki? == MediaWiki makes it easy to incorporate computer code in web pages. Other sorts of markup can be generated automatically: <blockquote> "Features like site maps , breadcrumbs , and other structural elements must become browser commands. Extracting information space navigation from the website will liberate users from the whims of Web designers and ensure consistent and standardized navigation features. The Web's history has shown that people use generic commands like the Back button far more than intermittent features, which, when they are available -- and users can actually find them -- tend to look and work differently on different sites." <cite>From [http://www.nngroup.com/articles/time-to-make-tech-work/ Time to Make Tech Work Jakob Nielsen's Alertbox: September 15, 2003]</cite> </blockquote> 20e4489d7c5606ab3aa6aba4d1a56d4265f3bfde 0 16 72 2014-05-04T23:21:04Z John 2 Created page with "__NOTOC__ <blockquote> "I have a hard time arguing that anything in XML is generically useful any more except for the basic syntax, which lets us apply some very handy low-lev..." wikitext text/x-wiki __NOTOC__ <blockquote> "I have a hard time arguing that anything in XML is generically useful any more except for the basic syntax, which lets us apply some very handy low-level tools like parsers and XSLT. The rest (XLink, schemas, etc.) has been a pointless trip into complexity." <cite>[http://lists.w3.org/Archives/Public/www-tag/2002Sep/0303.html Simon St.Laurent]</cite> </blockquote> <blockquote> "My own experience is that having Prolog, Scheme, and Haskell available it'll take a gun pointed at my head or an extremely large bribe to make me use XSLT for anything." <cite>[http://clip.dia.fi.upm.es/Mail/ciao-users/2001/000207.html Richard A. O'Keefe]</cite> </blockquote> ==Background== xml.pl is a module for parsing XML with Prolog, which provides Prolog applications with a simple 'Document Value Model' interface to XML documents. It has been used successfully in a number of applications. It supports a subset of XML suitable for XML Data and Worldwide Web applications, but is neither as strict nor as comprehensive as the [http://www.w3.org/TR/2000/REC-xml-20001006 XML 1.0 Specification] mandates. * It is not as strict because, while the specification must eliminate ambiguities, not all errors need to be regarded as faults, and some reasonable examples of real XML usage would have to be rejected if they were. * It is not as comprehensive because, where the XML specification makes provision for more or less complete DTDs to be provided as part of a document, xml.pl actions the local definition of ENTITIES only. Other DTD extensions are treated as commentary. ===Download [[xml.pl and plxml]]=== xml.pl and plxml, a small Windows application which embodies xml.pl, have been placed into the public domain to encourage the use of Prolog with XML. I hope that they will be useful to you, but they are not supported, and they are provided without any warranty of any kind. ==Specification== Three predicates are exported by the module: <code>xml_parse/[2,3]</code> , <code>xml_subterm/2</code> and <code>xml_pp/1</code> . ====xml_parse( {+Controls,} +?Chars, ?+Document )==== parses <var>Chars</var>, a list of character codes, to/from <var>Document</var>, a data structure of the form <code>xml(Attributes, Content)</code>, where: ''Attributes'' is a list of ''Name''=''CharData'' attributes from the (possibly implicit) XML signature of the document. ''Content'' is a (possibly empty) list comprising occurrences of: ; <code>pcdata(CharData)</code> : Text ; <code>comment(CharData)</code> : An xml comment; ; <code>namespace(URI, Prefix, Element)</code> : a Namespace ; <code>element(Tag, Attributes, Content)</code> : <Tag>..</Tag> encloses Content or <Tag/> if Content is empty <nowiki>[]</nowiki>. ; <code>instructions(Name, CharData)</code> : A PI <?Name CharData?> ; <code>cdata(CharData)</code> : <![CDATA[CharData]]> ; <code>doctype(Tag, DoctypeId)</code> : DTD <!DOCTYPE .. > The conversions are not completely symmetrical in that weaker XML is accepted than can be generated. Specifically, in-bound ''(Chars -> Document)'' parsing does not require strictly well-formed XML. If <var>Chars</var> does not represent well-formed XML, <var>Document</var> is instantiated to the term <code>malformed(Attributes, Content)</code> . The ''Content'' of a ''malformed/2'' structure can include: ; <code>unparsed( CharData )</code> : Text which has not been parsed ; <code>out_of_context(Tag)</code> : <Tag> is not closed in addition to the parsed-term types. Out-bound ''(<var>Document</var> -> <var>Chars</var>)'' parsing ''does'' require that <var>Document</var> defines well-formed XML. If an error is detected, a 'domain' exception is raised. The domain exception will attempt to identify the particular sub-term in error, and will list the ancestor elements of the sub-term in error as <code>Tag{(Id)}</code> terms - where ''Id'' is the value of any attribute named id. The <var>Controls</var> applying to in-bound ''(<var>Chars</var> -> <var>Document</var>)'' parsing are: ; <code>extended_characters(Boolean)</code> : Use the extended character entities for XHTML (default true). ; <code>format(Boolean)</code> : Remove layouts when no non-layout character data appears between elements (default true). ; <code>remove_attribute_prefixes(Boolean)</code> : Remove redundant prefixes from attributes - i.e. prefixes denoting the namespace of the parent element (default false). ; <code> allow_ampersand(Boolean) </code> : Allow unescaped ampersand characters (&) to occur in PCDATA (default false). For out-bound ''(<var>Document</var> -> <var>Chars</var>)'' parsing, the only available option is: ; <code>format(Boolean)</code> : Indent the element content, (default true) ===Types=== ; Tag : An atom naming an element ; Name : An atom, not naming an element ; URI : An atom giving the URI of a Namespace ; CharData : A "string": list of character codes. ; DoctypeId : one of: <code>public(CharData,&nbsp;CharData&nbsp;{,&nbsp;DTDLiterals})</code>, <code>system(CharData&nbsp;{,&nbsp;DTDLiterals})</code> or <code>local{(DTDLiterals)}</code> ; DTDLiterals : A non-empty list of <code>dtd_literal(CharData)</code> terms - e.g. [http://www.w3.org/TR/2000/REC-xml-20001006#NT-AttlistDecl attribute-list declarations]. ; Boolean : one of <code>true</code> or <code>false</code> ====xml_subterm( +XMLTerm, ?Subterm )==== unifies <var>Subterm</var> with a sub-term of <var>XMLTerm</var>. This can be especially useful when trying to test or retrieve a deeply-nested subterm from a document, as demonstrated in this [xml_example.html example program]. Note that <var>XMLTerm</var> is a sub-term of itself. ====xml_pp( +XMLDocument )==== "pretty prints" <var>XMLDocument</var> on the current output stream. ==Availability== On this site, you can download the [[XML Module]]. The module is also supplied as a library with the following Prologs: * It has been adapted for the [http://logtalk.org/ Logtalk Open source object-oriented extension to Prolog] by Paulo Moura. (See the folder "contributions/xml_parser" from release 2.29.1); * It is available in the [http://eclipseclp.org/ ECLiPSe Constraint Programming System], as a third-party library; * It has been ported to [http://www.probp.com/ B-Prolog] by Neng-Fa Zhou. * It has been adapted for [http://sicstus.sics.se/thirdparty.html SICStus Prolog] by Mats Carlsson. * It is included in [http://quintus.sics.se/ Quintus Prolog Release 3.5]. [[XML Query Use Cases with xml.pl]] is provided as an example to illustrate the way that the code can be used. ==Features of xml.pl== The <code>xml/2</code> data structure has some useful properties. ===Reusability=== Using a native Prolog representation of XML, in which terms represent document 'nodes', makes the parser reusable for any XML application. In effect, xml.pl encapsulates the application-independent tasks of document parsing and generation, which is essential where documents have components from more than one Namespace. ===Same Structure=== The Prolog term representing a document has the same structure as the document itself, which makes the correspondence between the literal representation of the Prolog term and the XML source readily apparent. For example, this simple [http://www.w3.org/Graphics/SVG/ SVG] image: <syntaxhighlight lang="xml"> <?xml version="1.0" standalone="no"?> <!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.0//EN" "http://www.w3.org/.../svg10.dtd" [ <!ENTITY redblue "fill: red; stroke: blue; stroke-width: 1"> ]> <svg xmlns="http://www.w3.org/2000/svg" width="500" height="500"> <circle cx=" 25 " cy=" 25 " r=" 24 " style="&redblue;"/> </svg> </syntaxhighlight> ... translates into this Prolog term: <syntaxhighlight lang="prolog"> xml( [version="1.0", standalone="no"], [ doctype( svg, public( "-//W3C//DTD SVG 1.0//EN", "http://www.w3.org/.../svg10.dtd" ) ), namespace( 'http://www.w3.org/2000/svg', "", element( svg, [width="500", height="500"], [ element( circle, [cx="25", cy="25", r="24", style="fill: red; stroke: blue; stroke-width: 1"], [] ) ] ) ) ] ). </syntaxhighlight> ===Efficient Manipulation=== Each type of node in an XML document is represented by a different Prolog functor, while data, (PCDATA, CDATA and Attribute Values), are left as "strings", (lists of character codes). The use of distinct functors for mark-up structures enables the efficient recursive traversal of a document, while leaving the data as strings facilitates the application-specific parsing of data content (aka [http://www.google.com/search?q=%22Micro-parsing%22+XML Micro-parsing]). For example, to turn every CDATA node into a PCDATA node with tabs expanded into spaces: <syntaxhighlight lang="prolog"> cdata_to_pcdata( cdata(CharsWithTabs), pcdata(CharsWithSpaces) ) :- tab_expansion( CharsWithTabs, CharsWithSpaces ). cdata_to_pcdata( xml(Attributes, Content1), xml(Attributes, Content2) ) :- cdata_to_pcdata( Content1, Content2 ). cdata_to_pcdata( namespace(URI,Pfx,Content1), namespace(URI,Pfx,Content2) ) :- cdata_to_pcdata( Content1, Content2 ). cdata_to_pcdata( element(Name,Atts,Content1), element(Name,Atts,Content2) ) :- cdata_to_pcdata( Content1, Content2 ). cdata_to_pcdata( [], [] ). cdata_to_pcdata( [H1|T1], [H2|T2] ) :- cdata_to_pcdata( H1, H2 ), cdata_to_pcdata( T1, T2 ). cdata_to_pcdata( pcdata(Chars), pcdata(Chars) ). cdata_to_pcdata( comment(Chars), comment(Chars) ). cdata_to_pcdata( instructions(Name, Chars), instructions(Name, Chars) ). cdata_to_pcdata( doctype(Tag, DoctypeId), doctype(Tag, DoctypeId) ). </syntaxhighlight> The above uses no 'cuts', but will not create any choice points with ground input. ===Elegance=== The resolution of entity references and the decomposition of the document into distinct nodes means that the calling application is not concerned with the occasionally messy syntax of XML documents. For example, the clean separation of namespace nodes means that Namespaces, which are useful in combining specifications developed separately, have similar usefulness in combining applications developed separately. b236ebc245b13c03c20d8390b839696481f09a45 73 72 2014-05-04T23:23:20Z John 2 /* Download xml.pl and plxml */ wikitext text/x-wiki __NOTOC__ <blockquote> "I have a hard time arguing that anything in XML is generically useful any more except for the basic syntax, which lets us apply some very handy low-level tools like parsers and XSLT. The rest (XLink, schemas, etc.) has been a pointless trip into complexity." <cite>[http://lists.w3.org/Archives/Public/www-tag/2002Sep/0303.html Simon St.Laurent]</cite> </blockquote> <blockquote> "My own experience is that having Prolog, Scheme, and Haskell available it'll take a gun pointed at my head or an extremely large bribe to make me use XSLT for anything." <cite>[http://clip.dia.fi.upm.es/Mail/ciao-users/2001/000207.html Richard A. O'Keefe]</cite> </blockquote> ==Background== xml.pl is a module for parsing XML with Prolog, which provides Prolog applications with a simple 'Document Value Model' interface to XML documents. It has been used successfully in a number of applications. It supports a subset of XML suitable for XML Data and Worldwide Web applications, but is neither as strict nor as comprehensive as the [http://www.w3.org/TR/2000/REC-xml-20001006 XML 1.0 Specification] mandates. * It is not as strict because, while the specification must eliminate ambiguities, not all errors need to be regarded as faults, and some reasonable examples of real XML usage would have to be rejected if they were. * It is not as comprehensive because, where the XML specification makes provision for more or less complete DTDs to be provided as part of a document, xml.pl actions the local definition of ENTITIES only. Other DTD extensions are treated as commentary. ===Download the [[XML Module]] (xml.pl and plxml)=== xml.pl and plxml, a small Windows application which embodies xml.pl, have been placed into the public domain to encourage the use of Prolog with XML. I hope that they will be useful to you, but they are not supported, and they are provided without any warranty of any kind. ==Specification== Three predicates are exported by the module: <code>xml_parse/[2,3]</code> , <code>xml_subterm/2</code> and <code>xml_pp/1</code> . ====xml_parse( {+Controls,} +?Chars, ?+Document )==== parses <var>Chars</var>, a list of character codes, to/from <var>Document</var>, a data structure of the form <code>xml(Attributes, Content)</code>, where: ''Attributes'' is a list of ''Name''=''CharData'' attributes from the (possibly implicit) XML signature of the document. ''Content'' is a (possibly empty) list comprising occurrences of: ; <code>pcdata(CharData)</code> : Text ; <code>comment(CharData)</code> : An xml comment; ; <code>namespace(URI, Prefix, Element)</code> : a Namespace ; <code>element(Tag, Attributes, Content)</code> : <Tag>..</Tag> encloses Content or <Tag/> if Content is empty <nowiki>[]</nowiki>. ; <code>instructions(Name, CharData)</code> : A PI <?Name CharData?> ; <code>cdata(CharData)</code> : <![CDATA[CharData]]> ; <code>doctype(Tag, DoctypeId)</code> : DTD <!DOCTYPE .. > The conversions are not completely symmetrical in that weaker XML is accepted than can be generated. Specifically, in-bound ''(Chars -> Document)'' parsing does not require strictly well-formed XML. If <var>Chars</var> does not represent well-formed XML, <var>Document</var> is instantiated to the term <code>malformed(Attributes, Content)</code> . The ''Content'' of a ''malformed/2'' structure can include: ; <code>unparsed( CharData )</code> : Text which has not been parsed ; <code>out_of_context(Tag)</code> : <Tag> is not closed in addition to the parsed-term types. Out-bound ''(<var>Document</var> -> <var>Chars</var>)'' parsing ''does'' require that <var>Document</var> defines well-formed XML. If an error is detected, a 'domain' exception is raised. The domain exception will attempt to identify the particular sub-term in error, and will list the ancestor elements of the sub-term in error as <code>Tag{(Id)}</code> terms - where ''Id'' is the value of any attribute named id. The <var>Controls</var> applying to in-bound ''(<var>Chars</var> -> <var>Document</var>)'' parsing are: ; <code>extended_characters(Boolean)</code> : Use the extended character entities for XHTML (default true). ; <code>format(Boolean)</code> : Remove layouts when no non-layout character data appears between elements (default true). ; <code>remove_attribute_prefixes(Boolean)</code> : Remove redundant prefixes from attributes - i.e. prefixes denoting the namespace of the parent element (default false). ; <code> allow_ampersand(Boolean) </code> : Allow unescaped ampersand characters (&) to occur in PCDATA (default false). For out-bound ''(<var>Document</var> -> <var>Chars</var>)'' parsing, the only available option is: ; <code>format(Boolean)</code> : Indent the element content, (default true) ===Types=== ; Tag : An atom naming an element ; Name : An atom, not naming an element ; URI : An atom giving the URI of a Namespace ; CharData : A "string": list of character codes. ; DoctypeId : one of: <code>public(CharData,&nbsp;CharData&nbsp;{,&nbsp;DTDLiterals})</code>, <code>system(CharData&nbsp;{,&nbsp;DTDLiterals})</code> or <code>local{(DTDLiterals)}</code> ; DTDLiterals : A non-empty list of <code>dtd_literal(CharData)</code> terms - e.g. [http://www.w3.org/TR/2000/REC-xml-20001006#NT-AttlistDecl attribute-list declarations]. ; Boolean : one of <code>true</code> or <code>false</code> ====xml_subterm( +XMLTerm, ?Subterm )==== unifies <var>Subterm</var> with a sub-term of <var>XMLTerm</var>. This can be especially useful when trying to test or retrieve a deeply-nested subterm from a document, as demonstrated in this [xml_example.html example program]. Note that <var>XMLTerm</var> is a sub-term of itself. ====xml_pp( +XMLDocument )==== "pretty prints" <var>XMLDocument</var> on the current output stream. ==Availability== On this site, you can download the [[XML Module]]. The module is also supplied as a library with the following Prologs: * It has been adapted for the [http://logtalk.org/ Logtalk Open source object-oriented extension to Prolog] by Paulo Moura. (See the folder "contributions/xml_parser" from release 2.29.1); * It is available in the [http://eclipseclp.org/ ECLiPSe Constraint Programming System], as a third-party library; * It has been ported to [http://www.probp.com/ B-Prolog] by Neng-Fa Zhou. * It has been adapted for [http://sicstus.sics.se/thirdparty.html SICStus Prolog] by Mats Carlsson. * It is included in [http://quintus.sics.se/ Quintus Prolog Release 3.5]. [[XML Query Use Cases with xml.pl]] is provided as an example to illustrate the way that the code can be used. ==Features of xml.pl== The <code>xml/2</code> data structure has some useful properties. ===Reusability=== Using a native Prolog representation of XML, in which terms represent document 'nodes', makes the parser reusable for any XML application. In effect, xml.pl encapsulates the application-independent tasks of document parsing and generation, which is essential where documents have components from more than one Namespace. ===Same Structure=== The Prolog term representing a document has the same structure as the document itself, which makes the correspondence between the literal representation of the Prolog term and the XML source readily apparent. For example, this simple [http://www.w3.org/Graphics/SVG/ SVG] image: <syntaxhighlight lang="xml"> <?xml version="1.0" standalone="no"?> <!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.0//EN" "http://www.w3.org/.../svg10.dtd" [ <!ENTITY redblue "fill: red; stroke: blue; stroke-width: 1"> ]> <svg xmlns="http://www.w3.org/2000/svg" width="500" height="500"> <circle cx=" 25 " cy=" 25 " r=" 24 " style="&redblue;"/> </svg> </syntaxhighlight> ... translates into this Prolog term: <syntaxhighlight lang="prolog"> xml( [version="1.0", standalone="no"], [ doctype( svg, public( "-//W3C//DTD SVG 1.0//EN", "http://www.w3.org/.../svg10.dtd" ) ), namespace( 'http://www.w3.org/2000/svg', "", element( svg, [width="500", height="500"], [ element( circle, [cx="25", cy="25", r="24", style="fill: red; stroke: blue; stroke-width: 1"], [] ) ] ) ) ] ). </syntaxhighlight> ===Efficient Manipulation=== Each type of node in an XML document is represented by a different Prolog functor, while data, (PCDATA, CDATA and Attribute Values), are left as "strings", (lists of character codes). The use of distinct functors for mark-up structures enables the efficient recursive traversal of a document, while leaving the data as strings facilitates the application-specific parsing of data content (aka [http://www.google.com/search?q=%22Micro-parsing%22+XML Micro-parsing]). For example, to turn every CDATA node into a PCDATA node with tabs expanded into spaces: <syntaxhighlight lang="prolog"> cdata_to_pcdata( cdata(CharsWithTabs), pcdata(CharsWithSpaces) ) :- tab_expansion( CharsWithTabs, CharsWithSpaces ). cdata_to_pcdata( xml(Attributes, Content1), xml(Attributes, Content2) ) :- cdata_to_pcdata( Content1, Content2 ). cdata_to_pcdata( namespace(URI,Pfx,Content1), namespace(URI,Pfx,Content2) ) :- cdata_to_pcdata( Content1, Content2 ). cdata_to_pcdata( element(Name,Atts,Content1), element(Name,Atts,Content2) ) :- cdata_to_pcdata( Content1, Content2 ). cdata_to_pcdata( [], [] ). cdata_to_pcdata( [H1|T1], [H2|T2] ) :- cdata_to_pcdata( H1, H2 ), cdata_to_pcdata( T1, T2 ). cdata_to_pcdata( pcdata(Chars), pcdata(Chars) ). cdata_to_pcdata( comment(Chars), comment(Chars) ). cdata_to_pcdata( instructions(Name, Chars), instructions(Name, Chars) ). cdata_to_pcdata( doctype(Tag, DoctypeId), doctype(Tag, DoctypeId) ). </syntaxhighlight> The above uses no 'cuts', but will not create any choice points with ground input. ===Elegance=== The resolution of entity references and the decomposition of the document into distinct nodes means that the calling application is not concerned with the occasionally messy syntax of XML documents. For example, the clean separation of namespace nodes means that Namespaces, which are useful in combining specifications developed separately, have similar usefulness in combining applications developed separately. 32e4c69a48d1019975a9f57dd2484dd28a73da0d 80 73 2014-06-12T20:35:48Z John 2 /* Availability */ wikitext text/x-wiki __NOTOC__ <blockquote> "I have a hard time arguing that anything in XML is generically useful any more except for the basic syntax, which lets us apply some very handy low-level tools like parsers and XSLT. The rest (XLink, schemas, etc.) has been a pointless trip into complexity." <cite>[http://lists.w3.org/Archives/Public/www-tag/2002Sep/0303.html Simon St.Laurent]</cite> </blockquote> <blockquote> "My own experience is that having Prolog, Scheme, and Haskell available it'll take a gun pointed at my head or an extremely large bribe to make me use XSLT for anything." <cite>[http://clip.dia.fi.upm.es/Mail/ciao-users/2001/000207.html Richard A. O'Keefe]</cite> </blockquote> ==Background== xml.pl is a module for parsing XML with Prolog, which provides Prolog applications with a simple 'Document Value Model' interface to XML documents. It has been used successfully in a number of applications. It supports a subset of XML suitable for XML Data and Worldwide Web applications, but is neither as strict nor as comprehensive as the [http://www.w3.org/TR/2000/REC-xml-20001006 XML 1.0 Specification] mandates. * It is not as strict because, while the specification must eliminate ambiguities, not all errors need to be regarded as faults, and some reasonable examples of real XML usage would have to be rejected if they were. * It is not as comprehensive because, where the XML specification makes provision for more or less complete DTDs to be provided as part of a document, xml.pl actions the local definition of ENTITIES only. Other DTD extensions are treated as commentary. ===Download the [[XML Module]] (xml.pl and plxml)=== xml.pl and plxml, a small Windows application which embodies xml.pl, have been placed into the public domain to encourage the use of Prolog with XML. I hope that they will be useful to you, but they are not supported, and they are provided without any warranty of any kind. ==Specification== Three predicates are exported by the module: <code>xml_parse/[2,3]</code> , <code>xml_subterm/2</code> and <code>xml_pp/1</code> . ====xml_parse( {+Controls,} +?Chars, ?+Document )==== parses <var>Chars</var>, a list of character codes, to/from <var>Document</var>, a data structure of the form <code>xml(Attributes, Content)</code>, where: ''Attributes'' is a list of ''Name''=''CharData'' attributes from the (possibly implicit) XML signature of the document. ''Content'' is a (possibly empty) list comprising occurrences of: ; <code>pcdata(CharData)</code> : Text ; <code>comment(CharData)</code> : An xml comment; ; <code>namespace(URI, Prefix, Element)</code> : a Namespace ; <code>element(Tag, Attributes, Content)</code> : <Tag>..</Tag> encloses Content or <Tag/> if Content is empty <nowiki>[]</nowiki>. ; <code>instructions(Name, CharData)</code> : A PI <?Name CharData?> ; <code>cdata(CharData)</code> : <![CDATA[CharData]]> ; <code>doctype(Tag, DoctypeId)</code> : DTD <!DOCTYPE .. > The conversions are not completely symmetrical in that weaker XML is accepted than can be generated. Specifically, in-bound ''(Chars -> Document)'' parsing does not require strictly well-formed XML. If <var>Chars</var> does not represent well-formed XML, <var>Document</var> is instantiated to the term <code>malformed(Attributes, Content)</code> . The ''Content'' of a ''malformed/2'' structure can include: ; <code>unparsed( CharData )</code> : Text which has not been parsed ; <code>out_of_context(Tag)</code> : <Tag> is not closed in addition to the parsed-term types. Out-bound ''(<var>Document</var> -> <var>Chars</var>)'' parsing ''does'' require that <var>Document</var> defines well-formed XML. If an error is detected, a 'domain' exception is raised. The domain exception will attempt to identify the particular sub-term in error, and will list the ancestor elements of the sub-term in error as <code>Tag{(Id)}</code> terms - where ''Id'' is the value of any attribute named id. The <var>Controls</var> applying to in-bound ''(<var>Chars</var> -> <var>Document</var>)'' parsing are: ; <code>extended_characters(Boolean)</code> : Use the extended character entities for XHTML (default true). ; <code>format(Boolean)</code> : Remove layouts when no non-layout character data appears between elements (default true). ; <code>remove_attribute_prefixes(Boolean)</code> : Remove redundant prefixes from attributes - i.e. prefixes denoting the namespace of the parent element (default false). ; <code> allow_ampersand(Boolean) </code> : Allow unescaped ampersand characters (&) to occur in PCDATA (default false). For out-bound ''(<var>Document</var> -> <var>Chars</var>)'' parsing, the only available option is: ; <code>format(Boolean)</code> : Indent the element content, (default true) ===Types=== ; Tag : An atom naming an element ; Name : An atom, not naming an element ; URI : An atom giving the URI of a Namespace ; CharData : A "string": list of character codes. ; DoctypeId : one of: <code>public(CharData,&nbsp;CharData&nbsp;{,&nbsp;DTDLiterals})</code>, <code>system(CharData&nbsp;{,&nbsp;DTDLiterals})</code> or <code>local{(DTDLiterals)}</code> ; DTDLiterals : A non-empty list of <code>dtd_literal(CharData)</code> terms - e.g. [http://www.w3.org/TR/2000/REC-xml-20001006#NT-AttlistDecl attribute-list declarations]. ; Boolean : one of <code>true</code> or <code>false</code> ====xml_subterm( +XMLTerm, ?Subterm )==== unifies <var>Subterm</var> with a sub-term of <var>XMLTerm</var>. This can be especially useful when trying to test or retrieve a deeply-nested subterm from a document, as demonstrated in this [xml_example.html example program]. Note that <var>XMLTerm</var> is a sub-term of itself. ====xml_pp( +XMLDocument )==== "pretty prints" <var>XMLDocument</var> on the current output stream. ==Availability== On this site, you can download the [[XML Module]]. The module is also supplied as a library with the following Prologs: * It has been adapted for the [http://logtalk.org/ Logtalk Open source object-oriented extension to Prolog] by Paulo Moura. (See the folder "contributions/xml_parser" from release 2.29.1); * It is available in the [http://eclipseclp.org/ ECLiPSe Constraint Programming System], as a third-party library; * It has been ported to [http://www.picat-lang.org/bprolog/ B-Prolog] by Neng-Fa Zhou. * It has been adapted for [http://sicstus.sics.se/thirdparty.html SICStus Prolog] by Mats Carlsson. * It is included in [http://quintus.sics.se/ Quintus Prolog Release 3.5]. [[XML Query Use Cases with xml.pl]] is provided as an example to illustrate the way that the code can be used. ==Features of xml.pl== The <code>xml/2</code> data structure has some useful properties. ===Reusability=== Using a native Prolog representation of XML, in which terms represent document 'nodes', makes the parser reusable for any XML application. In effect, xml.pl encapsulates the application-independent tasks of document parsing and generation, which is essential where documents have components from more than one Namespace. ===Same Structure=== The Prolog term representing a document has the same structure as the document itself, which makes the correspondence between the literal representation of the Prolog term and the XML source readily apparent. For example, this simple [http://www.w3.org/Graphics/SVG/ SVG] image: <syntaxhighlight lang="xml"> <?xml version="1.0" standalone="no"?> <!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.0//EN" "http://www.w3.org/.../svg10.dtd" [ <!ENTITY redblue "fill: red; stroke: blue; stroke-width: 1"> ]> <svg xmlns="http://www.w3.org/2000/svg" width="500" height="500"> <circle cx=" 25 " cy=" 25 " r=" 24 " style="&redblue;"/> </svg> </syntaxhighlight> ... translates into this Prolog term: <syntaxhighlight lang="prolog"> xml( [version="1.0", standalone="no"], [ doctype( svg, public( "-//W3C//DTD SVG 1.0//EN", "http://www.w3.org/.../svg10.dtd" ) ), namespace( 'http://www.w3.org/2000/svg', "", element( svg, [width="500", height="500"], [ element( circle, [cx="25", cy="25", r="24", style="fill: red; stroke: blue; stroke-width: 1"], [] ) ] ) ) ] ). </syntaxhighlight> ===Efficient Manipulation=== Each type of node in an XML document is represented by a different Prolog functor, while data, (PCDATA, CDATA and Attribute Values), are left as "strings", (lists of character codes). The use of distinct functors for mark-up structures enables the efficient recursive traversal of a document, while leaving the data as strings facilitates the application-specific parsing of data content (aka [http://www.google.com/search?q=%22Micro-parsing%22+XML Micro-parsing]). For example, to turn every CDATA node into a PCDATA node with tabs expanded into spaces: <syntaxhighlight lang="prolog"> cdata_to_pcdata( cdata(CharsWithTabs), pcdata(CharsWithSpaces) ) :- tab_expansion( CharsWithTabs, CharsWithSpaces ). cdata_to_pcdata( xml(Attributes, Content1), xml(Attributes, Content2) ) :- cdata_to_pcdata( Content1, Content2 ). cdata_to_pcdata( namespace(URI,Pfx,Content1), namespace(URI,Pfx,Content2) ) :- cdata_to_pcdata( Content1, Content2 ). cdata_to_pcdata( element(Name,Atts,Content1), element(Name,Atts,Content2) ) :- cdata_to_pcdata( Content1, Content2 ). cdata_to_pcdata( [], [] ). cdata_to_pcdata( [H1|T1], [H2|T2] ) :- cdata_to_pcdata( H1, H2 ), cdata_to_pcdata( T1, T2 ). cdata_to_pcdata( pcdata(Chars), pcdata(Chars) ). cdata_to_pcdata( comment(Chars), comment(Chars) ). cdata_to_pcdata( instructions(Name, Chars), instructions(Name, Chars) ). cdata_to_pcdata( doctype(Tag, DoctypeId), doctype(Tag, DoctypeId) ). </syntaxhighlight> The above uses no 'cuts', but will not create any choice points with ground input. ===Elegance=== The resolution of entity references and the decomposition of the document into distinct nodes means that the calling application is not concerned with the occasionally messy syntax of XML documents. For example, the clean separation of namespace nodes means that Namespaces, which are useful in combining specifications developed separately, have similar usefulness in combining applications developed separately. 189af9dd10e4cccba28519341e35350a7f36ad70 87 80 2015-01-07T21:12:38Z John 2 /* Specification */ wikitext text/x-wiki __NOTOC__ <blockquote> "I have a hard time arguing that anything in XML is generically useful any more except for the basic syntax, which lets us apply some very handy low-level tools like parsers and XSLT. The rest (XLink, schemas, etc.) has been a pointless trip into complexity." <cite>[http://lists.w3.org/Archives/Public/www-tag/2002Sep/0303.html Simon St.Laurent]</cite> </blockquote> <blockquote> "My own experience is that having Prolog, Scheme, and Haskell available it'll take a gun pointed at my head or an extremely large bribe to make me use XSLT for anything." <cite>[http://clip.dia.fi.upm.es/Mail/ciao-users/2001/000207.html Richard A. O'Keefe]</cite> </blockquote> ==Background== xml.pl is a module for parsing XML with Prolog, which provides Prolog applications with a simple 'Document Value Model' interface to XML documents. It has been used successfully in a number of applications. It supports a subset of XML suitable for XML Data and Worldwide Web applications, but is neither as strict nor as comprehensive as the [http://www.w3.org/TR/2000/REC-xml-20001006 XML 1.0 Specification] mandates. * It is not as strict because, while the specification must eliminate ambiguities, not all errors need to be regarded as faults, and some reasonable examples of real XML usage would have to be rejected if they were. * It is not as comprehensive because, where the XML specification makes provision for more or less complete DTDs to be provided as part of a document, xml.pl actions the local definition of ENTITIES only. Other DTD extensions are treated as commentary. ===Download the [[XML Module]] (xml.pl and plxml)=== xml.pl and plxml, a small Windows application which embodies xml.pl, have been placed into the public domain to encourage the use of Prolog with XML. I hope that they will be useful to you, but they are not supported, and they are provided without any warranty of any kind. ==Specification== Three predicates are exported by the module: <code>xml_parse/[2,3]</code> , <code>xml_subterm/2</code> and <code>xml_pp/1</code> . ====xml_parse( {+Controls,} +?Chars, ?+Document )==== parses <var>Chars</var>, a list of character codes, to/from <var>Document</var>, a data structure of the form <code>xml(Attributes, Content)</code>, where: ''Attributes'' is a list of ''Name''=''CharData'' attributes from the (possibly implicit) XML signature of the document. ''Content'' is a (possibly empty) list comprising occurrences of: ; <code>pcdata(CharData)</code> : Text ; <code>comment(CharData)</code> : An xml comment; ; <code>namespace(URI, Prefix, Element)</code> : a Namespace ; <code>element(Tag, Attributes, Content)</code> : <Tag>..</Tag> encloses Content or <Tag/> if Content is empty <nowiki>[]</nowiki>. ; <code>instructions(Name, CharData)</code> : A PI <?Name CharData?> ; <code>cdata(CharData)</code> : <![CDATA[CharData]]> ; <code>doctype(Tag, DoctypeId)</code> : DTD <!DOCTYPE .. > The conversions are not completely symmetrical in that weaker XML is accepted than can be generated. Specifically, in-bound ''(Chars -> Document)'' parsing does not require strictly well-formed XML. If <var>Chars</var> does not represent well-formed XML, <var>Document</var> is instantiated to the term <code>malformed(Attributes, Content)</code> . The ''Content'' of a ''malformed/2'' structure can include: ; <code>unparsed( CharData )</code> : Text which has not been parsed ; <code>out_of_context(Tag)</code> : <Tag> is not closed in addition to the parsed-term types. Out-bound ''(<var>Document</var> -> <var>Chars</var>)'' parsing ''does'' require that <var>Document</var> defines well-formed XML. If an error is detected, a 'domain' exception is raised. The domain exception will attempt to identify the particular sub-term in error, and will list the ancestor elements of the sub-term in error as <code>Tag{(Id)}</code> terms - where ''Id'' is the value of any attribute named id. The <var>Controls</var> applying to in-bound ''(<var>Chars</var> -> <var>Document</var>)'' parsing are: ; <code>extended_characters(Boolean)</code> : Use the extended character entities for XHTML (default true). ; <code>format(Boolean)</code> : Remove layouts when no non-layout character data appears between elements (default true). ; <code>remove_attribute_prefixes(Boolean)</code> : Remove redundant prefixes from attributes - i.e. prefixes denoting the namespace of the parent element (default false). ; <code> allow_ampersand(Boolean) </code> : Allow unescaped ampersand characters (&) to occur in PCDATA (default false). For out-bound ''(<var>Document</var> -> <var>Chars</var>)'' parsing, the only available option is: ; <code>format(Boolean)</code> : Indent the element content, (default true) ===Types=== ; Tag : An atom naming an element ; Name : An atom, not naming an element ; URI : An atom giving the URI of a Namespace ; CharData : A "string": list of character codes. ; DoctypeId : one of: <code>public(CharData,&nbsp;CharData&nbsp;{,&nbsp;DTDLiterals})</code>, <code>system(CharData&nbsp;{,&nbsp;DTDLiterals})</code> or <code>local{(DTDLiterals)}</code> ; DTDLiterals : A non-empty list of <code>dtd_literal(CharData)</code> terms - e.g. [http://www.w3.org/TR/2000/REC-xml-20001006#NT-AttlistDecl attribute-list declarations]. ; Boolean : one of <code>true</code> or <code>false</code> ====xml_subterm( +XMLTerm, ?Subterm )==== unifies <var>Subterm</var> with a sub-term of <var>XMLTerm</var>. This can be especially useful when trying to test or retrieve a deeply-nested subterm from a document, as demonstrated in this [xml_example.html example program]. Note that <var>XMLTerm</var> is a sub-term of itself. ====xml_pp( +XMLDocument )==== "pretty prints" <var>XMLDocument</var> on the current output stream. ==Availability== On this site, you can download the [[XML Module]]. The module is also supplied as a library with the following Prologs: * It has been adapted for the [http://logtalk.org/ Logtalk Open source object-oriented extension to Prolog] by Paulo Moura. (See the folder "contributions/xml_parser" from release 2.29.1); * It is available in the [http://eclipseclp.org/ ECLiPSe Constraint Programming System], as a third-party library; * It has been ported to [http://www.picat-lang.org/bprolog/ B-Prolog] by Neng-Fa Zhou. * It has been adapted for [http://sicstus.sics.se/thirdparty.html SICStus Prolog] by Mats Carlsson. * It is included in [http://quintus.sics.se/ Quintus Prolog Release 3.5]. [[XML Query Use Cases with xml.pl]] is provided as an example to illustrate the way that the code can be used. ==Features of xml.pl== The <code>xml/2</code> data structure has some useful properties. ===Reusability=== Using a native Prolog representation of XML, in which terms represent document 'nodes', makes the parser reusable for any XML application. In effect, xml.pl encapsulates the application-independent tasks of document parsing and generation, which is essential where documents have components from more than one Namespace. ===Same Structure=== The Prolog term representing a document has the same structure as the document itself, which makes the correspondence between the literal representation of the Prolog term and the XML source readily apparent. For example, this simple [http://www.w3.org/Graphics/SVG/ SVG] image: <syntaxhighlight lang="xml"> <?xml version="1.0" standalone="no"?> <!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.0//EN" "http://www.w3.org/.../svg10.dtd" [ <!ENTITY redblue "fill: red; stroke: blue; stroke-width: 1"> ]> <svg xmlns="http://www.w3.org/2000/svg" width="500" height="500"> <circle cx=" 25 " cy=" 25 " r=" 24 " style="&redblue;"/> </svg> </syntaxhighlight> ... translates into this Prolog term: <syntaxhighlight lang="prolog"> xml( [version="1.0", standalone="no"], [ doctype( svg, public( "-//W3C//DTD SVG 1.0//EN", "http://www.w3.org/.../svg10.dtd" ) ), namespace( 'http://www.w3.org/2000/svg', "", element( svg, [width="500", height="500"], [ element( circle, [cx="25", cy="25", r="24", style="fill: red; stroke: blue; stroke-width: 1"], [] ) ] ) ) ] ). </syntaxhighlight> ===Efficient Manipulation=== Each type of node in an XML document is represented by a different Prolog functor, while data, (PCDATA, CDATA and Attribute Values), are left as "strings", (lists of character codes). The use of distinct functors for mark-up structures enables the efficient recursive traversal of a document, while leaving the data as strings facilitates the application-specific parsing of data content (aka [http://www.google.com/search?q=%22Micro-parsing%22+XML Micro-parsing]). For example, to turn every CDATA node into a PCDATA node with tabs expanded into spaces: <syntaxhighlight lang="prolog"> cdata_to_pcdata( cdata(CharsWithTabs), pcdata(CharsWithSpaces) ) :- tab_expansion( CharsWithTabs, CharsWithSpaces ). cdata_to_pcdata( xml(Attributes, Content1), xml(Attributes, Content2) ) :- cdata_to_pcdata( Content1, Content2 ). cdata_to_pcdata( namespace(URI,Pfx,Content1), namespace(URI,Pfx,Content2) ) :- cdata_to_pcdata( Content1, Content2 ). cdata_to_pcdata( element(Name,Atts,Content1), element(Name,Atts,Content2) ) :- cdata_to_pcdata( Content1, Content2 ). cdata_to_pcdata( [], [] ). cdata_to_pcdata( [H1|T1], [H2|T2] ) :- cdata_to_pcdata( H1, H2 ), cdata_to_pcdata( T1, T2 ). cdata_to_pcdata( pcdata(Chars), pcdata(Chars) ). cdata_to_pcdata( comment(Chars), comment(Chars) ). cdata_to_pcdata( instructions(Name, Chars), instructions(Name, Chars) ). cdata_to_pcdata( doctype(Tag, DoctypeId), doctype(Tag, DoctypeId) ). </syntaxhighlight> The above uses no 'cuts', but will not create any choice points with ground input. ===Elegance=== The resolution of entity references and the decomposition of the document into distinct nodes means that the calling application is not concerned with the occasionally messy syntax of XML documents. For example, the clean separation of namespace nodes means that Namespaces, which are useful in combining specifications developed separately, have similar usefulness in combining applications developed separately. ccc9dc7ca6409be802ae91bc41dc25bbc59f711e 91 87 2015-02-12T23:41:36Z John 2 Fix broken link wikitext text/x-wiki __NOTOC__ <blockquote> "I have a hard time arguing that anything in XML is generically useful any more except for the basic syntax, which lets us apply some very handy low-level tools like parsers and XSLT. The rest (XLink, schemas, etc.) has been a pointless trip into complexity." <cite>[http://lists.w3.org/Archives/Public/www-tag/2002Sep/0303.html Simon St.Laurent]</cite> </blockquote> <blockquote> "My own experience is that having Prolog, Scheme, and Haskell available it'll take a gun pointed at my head or an extremely large bribe to make me use XSLT for anything." <cite>[http://clip.dia.fi.upm.es/Mail/ciao-users/2001/000207.html Richard A. O'Keefe]</cite> </blockquote> ==Background== xml.pl is a module for parsing XML with Prolog, which provides Prolog applications with a simple 'Document Value Model' interface to XML documents. It has been used successfully in a number of applications. It supports a subset of XML suitable for XML Data and Worldwide Web applications, but is neither as strict nor as comprehensive as the [http://www.w3.org/TR/2000/REC-xml-20001006 XML 1.0 Specification] mandates. * It is not as strict because, while the specification must eliminate ambiguities, not all errors need to be regarded as faults, and some reasonable examples of real XML usage would have to be rejected if they were. * It is not as comprehensive because, where the XML specification makes provision for more or less complete DTDs to be provided as part of a document, xml.pl actions the local definition of ENTITIES only. Other DTD extensions are treated as commentary. ===Download the [[XML Module]] (xml.pl and plxml)=== xml.pl and plxml, a small Windows application which embodies xml.pl, have been placed into the public domain to encourage the use of Prolog with XML. I hope that they will be useful to you, but they are not supported, and they are provided without any warranty of any kind. ==Specification== Three predicates are exported by the module: <code>xml_parse/[2,3]</code> , <code>xml_subterm/2</code> and <code>xml_pp/1</code> . ====xml_parse( {+Controls,} +?Chars, ?+Document )==== parses <var>Chars</var>, a list of character codes, to/from <var>Document</var>, a data structure of the form <code>xml(Attributes, Content)</code>, where: ''Attributes'' is a list of ''Name''=''CharData'' attributes from the (possibly implicit) XML signature of the document. ''Content'' is a (possibly empty) list comprising occurrences of: ; <code>pcdata(CharData)</code> : Text ; <code>comment(CharData)</code> : An xml comment; ; <code>namespace(URI, Prefix, Element)</code> : a Namespace ; <code>element(Tag, Attributes, Content)</code> : <Tag>..</Tag> encloses Content or <Tag/> if Content is empty <nowiki>[]</nowiki>. ; <code>instructions(Name, CharData)</code> : A PI <?Name CharData?> ; <code>cdata(CharData)</code> : <![CDATA[CharData]]> ; <code>doctype(Tag, DoctypeId)</code> : DTD <!DOCTYPE .. > The conversions are not completely symmetrical in that weaker XML is accepted than can be generated. Specifically, in-bound ''(Chars -> Document)'' parsing does not require strictly well-formed XML. If <var>Chars</var> does not represent well-formed XML, <var>Document</var> is instantiated to the term <code>malformed(Attributes, Content)</code> . The ''Content'' of a ''malformed/2'' structure can include: ; <code>unparsed( CharData )</code> : Text which has not been parsed ; <code>out_of_context(Tag)</code> : <Tag> is not closed in addition to the parsed-term types. Out-bound ''(<var>Document</var> -> <var>Chars</var>)'' parsing ''does'' require that <var>Document</var> defines well-formed XML. If an error is detected, a 'domain' exception is raised. The domain exception will attempt to identify the particular sub-term in error, and will list the ancestor elements of the sub-term in error as <code>Tag{(Id)}</code> terms - where ''Id'' is the value of any attribute named id. The <var>Controls</var> applying to in-bound ''(<var>Chars</var> -> <var>Document</var>)'' parsing are: ; <code>extended_characters(Boolean)</code> : Use the extended character entities for XHTML (default true). ; <code>format(Boolean)</code> : Remove layouts when no non-layout character data appears between elements (default true). ; <code>remove_attribute_prefixes(Boolean)</code> : Remove redundant prefixes from attributes - i.e. prefixes denoting the namespace of the parent element (default false). ; <code> allow_ampersand(Boolean) </code> : Allow unescaped ampersand characters (&) to occur in PCDATA (default false). For out-bound ''(<var>Document</var> -> <var>Chars</var>)'' parsing, the only available option is: ; <code>format(Boolean)</code> : Indent the element content, (default true) ===Types=== ; Tag : An atom naming an element ; Name : An atom, not naming an element ; URI : An atom giving the URI of a Namespace ; CharData : A "string": list of character codes. ; DoctypeId : one of: <code>public(CharData,&nbsp;CharData&nbsp;{,&nbsp;DTDLiterals})</code>, <code>system(CharData&nbsp;{,&nbsp;DTDLiterals})</code> or <code>local{(DTDLiterals)}</code> ; DTDLiterals : A non-empty list of <code>dtd_literal(CharData)</code> terms - e.g. [http://www.w3.org/TR/2000/REC-xml-20001006#NT-AttlistDecl attribute-list declarations]. ; Boolean : one of <code>true</code> or <code>false</code> ====xml_subterm( +XMLTerm, ?Subterm )==== unifies <var>Subterm</var> with a sub-term of <var>XMLTerm</var>. This can be especially useful when trying to test or retrieve a deeply-nested subterm from a document, as demonstrated in the [[XML Query Use Cases with xml.pl]] examples. Note that <var>XMLTerm</var> is a sub-term of itself. ====xml_pp( +XMLDocument )==== "pretty prints" <var>XMLDocument</var> on the current output stream. ==Availability== On this site, you can download the [[XML Module]]. The module is also supplied as a library with the following Prologs: * It has been adapted for the [http://logtalk.org/ Logtalk Open source object-oriented extension to Prolog] by Paulo Moura. (See the folder "contributions/xml_parser" from release 2.29.1); * It is available in the [http://eclipseclp.org/ ECLiPSe Constraint Programming System], as a third-party library; * It has been ported to [http://www.picat-lang.org/bprolog/ B-Prolog] by Neng-Fa Zhou. * It has been adapted for [http://sicstus.sics.se/thirdparty.html SICStus Prolog] by Mats Carlsson. * It is included in [http://quintus.sics.se/ Quintus Prolog Release 3.5]. [[XML Query Use Cases with xml.pl]] is provided as an example to illustrate the way that the code can be used. ==Features of xml.pl== The <code>xml/2</code> data structure has some useful properties. ===Reusability=== Using a native Prolog representation of XML, in which terms represent document 'nodes', makes the parser reusable for any XML application. In effect, xml.pl encapsulates the application-independent tasks of document parsing and generation, which is essential where documents have components from more than one Namespace. ===Same Structure=== The Prolog term representing a document has the same structure as the document itself, which makes the correspondence between the literal representation of the Prolog term and the XML source readily apparent. For example, this simple [http://www.w3.org/Graphics/SVG/ SVG] image: <syntaxhighlight lang="xml"> <?xml version="1.0" standalone="no"?> <!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.0//EN" "http://www.w3.org/.../svg10.dtd" [ <!ENTITY redblue "fill: red; stroke: blue; stroke-width: 1"> ]> <svg xmlns="http://www.w3.org/2000/svg" width="500" height="500"> <circle cx=" 25 " cy=" 25 " r=" 24 " style="&redblue;"/> </svg> </syntaxhighlight> ... translates into this Prolog term: <syntaxhighlight lang="prolog"> xml( [version="1.0", standalone="no"], [ doctype( svg, public( "-//W3C//DTD SVG 1.0//EN", "http://www.w3.org/.../svg10.dtd" ) ), namespace( 'http://www.w3.org/2000/svg', "", element( svg, [width="500", height="500"], [ element( circle, [cx="25", cy="25", r="24", style="fill: red; stroke: blue; stroke-width: 1"], [] ) ] ) ) ] ). </syntaxhighlight> ===Efficient Manipulation=== Each type of node in an XML document is represented by a different Prolog functor, while data, (PCDATA, CDATA and Attribute Values), are left as "strings", (lists of character codes). The use of distinct functors for mark-up structures enables the efficient recursive traversal of a document, while leaving the data as strings facilitates the application-specific parsing of data content (aka [http://www.google.com/search?q=%22Micro-parsing%22+XML Micro-parsing]). For example, to turn every CDATA node into a PCDATA node with tabs expanded into spaces: <syntaxhighlight lang="prolog"> cdata_to_pcdata( cdata(CharsWithTabs), pcdata(CharsWithSpaces) ) :- tab_expansion( CharsWithTabs, CharsWithSpaces ). cdata_to_pcdata( xml(Attributes, Content1), xml(Attributes, Content2) ) :- cdata_to_pcdata( Content1, Content2 ). cdata_to_pcdata( namespace(URI,Pfx,Content1), namespace(URI,Pfx,Content2) ) :- cdata_to_pcdata( Content1, Content2 ). cdata_to_pcdata( element(Name,Atts,Content1), element(Name,Atts,Content2) ) :- cdata_to_pcdata( Content1, Content2 ). cdata_to_pcdata( [], [] ). cdata_to_pcdata( [H1|T1], [H2|T2] ) :- cdata_to_pcdata( H1, H2 ), cdata_to_pcdata( T1, T2 ). cdata_to_pcdata( pcdata(Chars), pcdata(Chars) ). cdata_to_pcdata( comment(Chars), comment(Chars) ). cdata_to_pcdata( instructions(Name, Chars), instructions(Name, Chars) ). cdata_to_pcdata( doctype(Tag, DoctypeId), doctype(Tag, DoctypeId) ). </syntaxhighlight> The above uses no 'cuts', but will not create any choice points with ground input. ===Elegance=== The resolution of entity references and the decomposition of the document into distinct nodes means that the calling application is not concerned with the occasionally messy syntax of XML documents. For example, the clean separation of namespace nodes means that Namespaces, which are useful in combining specifications developed separately, have similar usefulness in combining applications developed separately. 250feefb97e8699953df90fc88a9055c8a54881c 100 91 2015-05-07T13:25:16Z John 2 wikitext text/x-wiki __NOTOC__ <blockquote> &ldquo;I have a hard time arguing that anything in XML is generically useful any more except for the basic syntax, which lets us apply some very handy low-level tools like parsers and XSLT. The rest (XLink, schemas, etc.) has been a pointless trip into complexity.&rdquo; <cite>[http://lists.w3.org/Archives/Public/www-tag/2002Sep/0303.html Simon St.Laurent]</cite> </blockquote> <blockquote> &ldquo;My own experience is that having Prolog, Scheme, and Haskell available it'll take a gun pointed at my head or an extremely large bribe to make me use XSLT for anything.&rdquo; <cite>[http://clip.dia.fi.upm.es/Mail/ciao-users/2001/000207.html Richard A. O'Keefe]</cite> </blockquote> ==Background== xml.pl is a module for parsing XML with Prolog, which provides Prolog applications with a simple 'Document Value Model' interface to XML documents. It has been used successfully in a number of applications. It supports a subset of XML suitable for XML Data and Worldwide Web applications, but is neither as strict nor as comprehensive as the [http://www.w3.org/TR/2000/REC-xml-20001006 XML 1.0 Specification] mandates. * It is not as strict because, while the specification must eliminate ambiguities, not all errors need to be regarded as faults, and some reasonable examples of real XML usage would have to be rejected if they were. * It is not as comprehensive because, where the XML specification makes provision for more or less complete DTDs to be provided as part of a document, xml.pl actions the local definition of ENTITIES only. Other DTD extensions are treated as commentary. ===Download the [[XML Module]] (xml.pl and plxml)=== xml.pl and plxml, a small Windows application which embodies xml.pl, have been placed into the public domain to encourage the use of Prolog with XML. I hope that they will be useful to you, but they are not supported, and they are provided without any warranty of any kind. ==Specification== Three predicates are exported by the module: <code>xml_parse/[2,3]</code> , <code>xml_subterm/2</code> and <code>xml_pp/1</code> . ====xml_parse( {+Controls,} +?Chars, ?+Document )==== parses <var>Chars</var>, a list of character codes, to/from <var>Document</var>, a data structure of the form <code>xml(Attributes, Content)</code>, where: ''Attributes'' is a list of ''Name''=''CharData'' attributes from the (possibly implicit) XML signature of the document. ''Content'' is a (possibly empty) list comprising occurrences of: ; <code>pcdata(CharData)</code> : Text ; <code>comment(CharData)</code> : An xml comment; ; <code>namespace(URI, Prefix, Element)</code> : a Namespace ; <code>element(Tag, Attributes, Content)</code> : <Tag>..</Tag> encloses Content or <Tag/> if Content is empty <nowiki>[]</nowiki>. ; <code>instructions(Name, CharData)</code> : A PI <?Name CharData?> ; <code>cdata(CharData)</code> : <![CDATA[CharData]]> ; <code>doctype(Tag, DoctypeId)</code> : DTD <!DOCTYPE .. > The conversions are not completely symmetrical in that weaker XML is accepted than can be generated. Specifically, in-bound ''(Chars -> Document)'' parsing does not require strictly well-formed XML. If <var>Chars</var> does not represent well-formed XML, <var>Document</var> is instantiated to the term <code>malformed(Attributes, Content)</code> . The ''Content'' of a ''malformed/2'' structure can include: ; <code>unparsed( CharData )</code> : Text which has not been parsed ; <code>out_of_context(Tag)</code> : <Tag> is not closed in addition to the parsed-term types. Out-bound ''(<var>Document</var> -> <var>Chars</var>)'' parsing ''does'' require that <var>Document</var> defines well-formed XML. If an error is detected, a 'domain' exception is raised. The domain exception will attempt to identify the particular sub-term in error, and will list the ancestor elements of the sub-term in error as <code>Tag{(Id)}</code> terms - where ''Id'' is the value of any attribute named id. The <var>Controls</var> applying to in-bound ''(<var>Chars</var> -> <var>Document</var>)'' parsing are: ; <code>extended_characters(Boolean)</code> : Use the extended character entities for XHTML (default true). ; <code>format(Boolean)</code> : Remove layouts when no non-layout character data appears between elements (default true). ; <code>remove_attribute_prefixes(Boolean)</code> : Remove redundant prefixes from attributes - i.e. prefixes denoting the namespace of the parent element (default false). ; <code> allow_ampersand(Boolean) </code> : Allow unescaped ampersand characters (&) to occur in PCDATA (default false). For out-bound ''(<var>Document</var> -> <var>Chars</var>)'' parsing, the only available option is: ; <code>format(Boolean)</code> : Indent the element content, (default true) ===Types=== ; Tag : An atom naming an element ; Name : An atom, not naming an element ; URI : An atom giving the URI of a Namespace ; CharData : A "string": list of character codes. ; DoctypeId : one of: <code>public(CharData,&nbsp;CharData&nbsp;{,&nbsp;DTDLiterals})</code>, <code>system(CharData&nbsp;{,&nbsp;DTDLiterals})</code> or <code>local{(DTDLiterals)}</code> ; DTDLiterals : A non-empty list of <code>dtd_literal(CharData)</code> terms - e.g. [http://www.w3.org/TR/2000/REC-xml-20001006#NT-AttlistDecl attribute-list declarations]. ; Boolean : one of <code>true</code> or <code>false</code> ====xml_subterm( +XMLTerm, ?Subterm )==== unifies <var>Subterm</var> with a sub-term of <var>XMLTerm</var>. This can be especially useful when trying to test or retrieve a deeply-nested subterm from a document, as demonstrated in the [[XML Query Use Cases with xml.pl]] examples. Note that <var>XMLTerm</var> is a sub-term of itself. ====xml_pp( +XMLDocument )==== "pretty prints" <var>XMLDocument</var> on the current output stream. ==Availability== On this site, you can download the [[XML Module]]. The module is also supplied as a library with the following Prologs: * It has been adapted for the [http://logtalk.org/ Logtalk Open source object-oriented extension to Prolog] by Paulo Moura. (See the folder "contributions/xml_parser" from release 2.29.1); * It is available in the [http://eclipseclp.org/ ECLiPSe Constraint Programming System], as a third-party library; * It has been ported to [http://www.picat-lang.org/bprolog/ B-Prolog] by Neng-Fa Zhou. * It has been adapted for [http://sicstus.sics.se/thirdparty.html SICStus Prolog] by Mats Carlsson. * It is included in [http://quintus.sics.se/ Quintus Prolog Release 3.5]. [[XML Query Use Cases with xml.pl]] is provided as an example to illustrate the way that the code can be used. ==Features of xml.pl== The <code>xml/2</code> data structure has some useful properties. ===Reusability=== Using a native Prolog representation of XML, in which terms represent document 'nodes', makes the parser reusable for any XML application. In effect, xml.pl encapsulates the application-independent tasks of document parsing and generation, which is essential where documents have components from more than one Namespace. ===Same Structure=== The Prolog term representing a document has the same structure as the document itself, which makes the correspondence between the literal representation of the Prolog term and the XML source readily apparent. For example, this simple [http://www.w3.org/Graphics/SVG/ SVG] image: <syntaxhighlight lang="xml"> <?xml version="1.0" standalone="no"?> <!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.0//EN" "http://www.w3.org/.../svg10.dtd" [ <!ENTITY redblue "fill: red; stroke: blue; stroke-width: 1"> ]> <svg xmlns="http://www.w3.org/2000/svg" width="500" height="500"> <circle cx=" 25 " cy=" 25 " r=" 24 " style="&redblue;"/> </svg> </syntaxhighlight> ... translates into this Prolog term: <syntaxhighlight lang="prolog"> xml( [version="1.0", standalone="no"], [ doctype( svg, public( "-//W3C//DTD SVG 1.0//EN", "http://www.w3.org/.../svg10.dtd" ) ), namespace( 'http://www.w3.org/2000/svg', "", element( svg, [width="500", height="500"], [ element( circle, [cx="25", cy="25", r="24", style="fill: red; stroke: blue; stroke-width: 1"], [] ) ] ) ) ] ). </syntaxhighlight> ===Efficient Manipulation=== Each type of node in an XML document is represented by a different Prolog functor, while data, (PCDATA, CDATA and Attribute Values), are left as "strings", (lists of character codes). The use of distinct functors for mark-up structures enables the efficient recursive traversal of a document, while leaving the data as strings facilitates the application-specific parsing of data content (aka [http://www.google.com/search?q=%22Micro-parsing%22+XML Micro-parsing]). For example, to turn every CDATA node into a PCDATA node with tabs expanded into spaces: <syntaxhighlight lang="prolog"> cdata_to_pcdata( cdata(CharsWithTabs), pcdata(CharsWithSpaces) ) :- tab_expansion( CharsWithTabs, CharsWithSpaces ). cdata_to_pcdata( xml(Attributes, Content1), xml(Attributes, Content2) ) :- cdata_to_pcdata( Content1, Content2 ). cdata_to_pcdata( namespace(URI,Pfx,Content1), namespace(URI,Pfx,Content2) ) :- cdata_to_pcdata( Content1, Content2 ). cdata_to_pcdata( element(Name,Atts,Content1), element(Name,Atts,Content2) ) :- cdata_to_pcdata( Content1, Content2 ). cdata_to_pcdata( [], [] ). cdata_to_pcdata( [H1|T1], [H2|T2] ) :- cdata_to_pcdata( H1, H2 ), cdata_to_pcdata( T1, T2 ). cdata_to_pcdata( pcdata(Chars), pcdata(Chars) ). cdata_to_pcdata( comment(Chars), comment(Chars) ). cdata_to_pcdata( instructions(Name, Chars), instructions(Name, Chars) ). cdata_to_pcdata( doctype(Tag, DoctypeId), doctype(Tag, DoctypeId) ). </syntaxhighlight> The above uses no 'cuts', but will not create any choice points with ground input. ===Elegance=== The resolution of entity references and the decomposition of the document into distinct nodes means that the calling application is not concerned with the occasionally messy syntax of XML documents. For example, the clean separation of namespace nodes means that Namespaces, which are useful in combining specifications developed separately, have similar usefulness in combining applications developed separately. 744874c0b8f5902591243a5f63a8583d8201c28a 0 17 74 2014-05-04T23:24:38Z John 2 Created page with "__NOTOC__ == Terms and Conditions == This program is offered free of charge as unsupported source code. You may use it, copy it, distribute it, modify it or sell it without re..." wikitext text/x-wiki __NOTOC__ == Terms and Conditions == This program is offered free of charge as unsupported source code. You may use it, copy it, distribute it, modify it or sell it without restriction. I hope that it will be useful to you, but it is provided &quot;as is&quot; without any warranty express or implied, including but not limited to the warranty of non-infringement and the implied warranties of merchantability and fitness for a particular purpose. == Download == <pre>Current Version: 3.6 released 2013/05/17</pre> [https://binding-time.co.uk/download/xmlpl.tar.gz Download the source code] in tar.gz format (21KB) [https://binding-time.co.uk/download/xmlpl.zip Download the source code and Windows application] as a ZIP file (428KB) == Extracting the files == Unzip the files to create a folder structure as follows: <pre>+---bin | | plxml.exe : Application | | libpl.dll : Quintus Prolog support DLL | | libqp.dll : &quot; &quot; &quot; &quot; | | qpconsole.dll : &quot; &quot; &quot; &quot; | | qpeng.dll : &quot; &quot; &quot; &quot; | +---source | xml.pl : Quintus Prolog module wrapper | xml.iso.pl : ISO Prolog module wrapper | xml.lpa.pl : LPA Prolog wrapper | xml_driver.pl : Driver | xml_acquisition.pl : Chars -&gt; Document parsing | xml_generation.pl : Document -&gt; Chars parsing | xml_diagnosis.pl : Document -&gt; Chars parsing exception | xml_pp.pl : Document pretty-printing | xml_utilities.pl : Shared code</pre> == The Source Code (xml.pl) == xml is intended to be a modular module: it should be easy to build a program that can output XML, but not read it, or vice versa. Similarly, you may be happy to dispense with diagnosis once you are sure that your code will only try to make valid calls to xml_parse/2. It is intended that the code should be very portable too. Clearly, some small changes will be needed between platforms, but these should be limited to the top-level wrapper file which contains the potentially non-portable code. It is suggested that you name the wrapper file you need as xml.pl == Using plxml.exe == The application and the DLLs should reside in the same directory, unless you have a good reason to do something different. The application is invoked with two file names as operands, i.e. plxml [-(c|p|a)*] INPUT OUTPUT If INPUT contains a Prolog xml/2 clause, OUTPUT is written as the corresponding XML. If INPUT contains a Prolog malformed/2 clause, OUTPUT is written as the corresponding XML with the unparsed/1 and out_of_context/1 terms written as CDATA. If INPUT is an XML file, OUTPUT is written as a Prolog xml/2 or malformed/2 clause. INPUT and/or OUTPUT may be &quot;-&quot; indicating stdin/stdout respectively. ; The -a option : allows unescaped &amp; (ampersand) characters to occur in PCDATA - an increasingly common fault in the XML &quot;in the wild&quot;; ; The -p option : preserves whitespace; ; The -c option : causes prefixes to be removed from attribute names if the explicitly denoted namespace is that of the containing tag - i.e. is the namespace implicitly specified (XML input only); Plxml's Prolog output is compatible with [http://www.lpa.co.uk/ LPA Prolog]. Specifically, strings containing ~ (tilde) characters are output as lists of character codes. === Using plxml as a development tool === A common use of xml.pl is to populate template XML documents with answers from a Prolog application. A nice approach is to design a prototype document and then translate this into an xml/2 term with plxml. For example, a prototype HTML page could be produced with a WYSIWYG XHTML editor. Alternatively, if your editor produces plain HTML, you can use plxml in combination with [http://tidy.sourceforge.net/ &quot;tidy&quot; from the SourceForge site] e.g. tidy -asxhtml -ascii [HTMLFile] | plxml - [PLFile] Similarly, during prototyping/early development it may be convenient to use plxml as the interface, rather than integrating xml.pl itself. === Using plxml to repair XML === plxml can repair broken XML, sometimes: plxml -ac [Broken XML] - | plxml - [Fixed XML] === Character Encoding === By default, plxml can accept input encoded as UTF-8 or UTF-16, which encompasses plain 7-bit ASCII. The iso-8859-1, iso-8859-2, iso-8859-15 and windows-1252 8-bit encodings are supported, but they must be identified correctly in the signature of the XML document. xml.pl, (and therefore plxml), output a plain ASCII encoding with the following properties: * In all character data, the characters &amp; &lt; and &gt; are encoded as &amp;amp; &amp;lt; and &amp;gt; respectively. * In non-parsed character data, such as Attribute Values, the characters &quot; and ' are encoded as &amp;quot; and &amp;apos; respectively. * Any character codes &gt; 127 are output as decimal character entities e.g. 160 as &amp;#160;. * Only [http://www.w3.org/TR/2000/REC-xml-20001006#NT-Char character codes allowed by the XML specification] are encoded by xml_parse/[2,3]. e37719fcddf385b706b72904e93464cbe050afda 83 74 2014-07-08T23:24:19Z John 2 /* Download */ wikitext text/x-wiki __NOTOC__ == Terms and Conditions == This program is offered free of charge as unsupported source code. You may use it, copy it, distribute it, modify it or sell it without restriction. I hope that it will be useful to you, but it is provided &quot;as is&quot; without any warranty express or implied, including but not limited to the warranty of non-infringement and the implied warranties of merchantability and fitness for a particular purpose. == Download == <pre>Current Version: 3.7 released 2014/07/09</pre> [https://binding-time.co.uk/download/xmlpl.tar.gz Download the source code] in tar.gz format (21KB) [https://binding-time.co.uk/download/xmlpl.zip Download the source code and Windows application] as a ZIP file (431KB) == Extracting the files == Unzip the files to create a folder structure as follows: <pre>+---bin | | plxml.exe : Application | | libpl.dll : Quintus Prolog support DLL | | libqp.dll : &quot; &quot; &quot; &quot; | | qpconsole.dll : &quot; &quot; &quot; &quot; | | qpeng.dll : &quot; &quot; &quot; &quot; | +---source | xml.pl : Quintus Prolog module wrapper | xml.iso.pl : ISO Prolog module wrapper | xml.lpa.pl : LPA Prolog wrapper | xml_driver.pl : Driver | xml_acquisition.pl : Chars -&gt; Document parsing | xml_generation.pl : Document -&gt; Chars parsing | xml_diagnosis.pl : Document -&gt; Chars parsing exception | xml_pp.pl : Document pretty-printing | xml_utilities.pl : Shared code</pre> == The Source Code (xml.pl) == xml is intended to be a modular module: it should be easy to build a program that can output XML, but not read it, or vice versa. Similarly, you may be happy to dispense with diagnosis once you are sure that your code will only try to make valid calls to xml_parse/2. It is intended that the code should be very portable too. Clearly, some small changes will be needed between platforms, but these should be limited to the top-level wrapper file which contains the potentially non-portable code. It is suggested that you name the wrapper file you need as xml.pl == Using plxml.exe == The application and the DLLs should reside in the same directory, unless you have a good reason to do something different. The application is invoked with two file names as operands, i.e. plxml [-(c|p|a)*] INPUT OUTPUT If INPUT contains a Prolog xml/2 clause, OUTPUT is written as the corresponding XML. If INPUT contains a Prolog malformed/2 clause, OUTPUT is written as the corresponding XML with the unparsed/1 and out_of_context/1 terms written as CDATA. If INPUT is an XML file, OUTPUT is written as a Prolog xml/2 or malformed/2 clause. INPUT and/or OUTPUT may be &quot;-&quot; indicating stdin/stdout respectively. ; The -a option : allows unescaped &amp; (ampersand) characters to occur in PCDATA - an increasingly common fault in the XML &quot;in the wild&quot;; ; The -p option : preserves whitespace; ; The -c option : causes prefixes to be removed from attribute names if the explicitly denoted namespace is that of the containing tag - i.e. is the namespace implicitly specified (XML input only); Plxml's Prolog output is compatible with [http://www.lpa.co.uk/ LPA Prolog]. Specifically, strings containing ~ (tilde) characters are output as lists of character codes. === Using plxml as a development tool === A common use of xml.pl is to populate template XML documents with answers from a Prolog application. A nice approach is to design a prototype document and then translate this into an xml/2 term with plxml. For example, a prototype HTML page could be produced with a WYSIWYG XHTML editor. Alternatively, if your editor produces plain HTML, you can use plxml in combination with [http://tidy.sourceforge.net/ &quot;tidy&quot; from the SourceForge site] e.g. tidy -asxhtml -ascii [HTMLFile] | plxml - [PLFile] Similarly, during prototyping/early development it may be convenient to use plxml as the interface, rather than integrating xml.pl itself. === Using plxml to repair XML === plxml can repair broken XML, sometimes: plxml -ac [Broken XML] - | plxml - [Fixed XML] === Character Encoding === By default, plxml can accept input encoded as UTF-8 or UTF-16, which encompasses plain 7-bit ASCII. The iso-8859-1, iso-8859-2, iso-8859-15 and windows-1252 8-bit encodings are supported, but they must be identified correctly in the signature of the XML document. xml.pl, (and therefore plxml), output a plain ASCII encoding with the following properties: * In all character data, the characters &amp; &lt; and &gt; are encoded as &amp;amp; &amp;lt; and &amp;gt; respectively. * In non-parsed character data, such as Attribute Values, the characters &quot; and ' are encoded as &amp;quot; and &amp;apos; respectively. * Any character codes &gt; 127 are output as decimal character entities e.g. 160 as &amp;#160;. * Only [http://www.w3.org/TR/2000/REC-xml-20001006#NT-Char character codes allowed by the XML specification] are encoded by xml_parse/[2,3]. 4c1a452e042a320d30394bb98cf233941852566f 0 18 75 2014-05-04T23:32:09Z John 2 Created page with "__NOTOC__ The following is a complete example to illustrate how the xml.pl module can be used. It exercises both the input and output parsing modes of <code>xml_parse/[2,3]</c..." wikitext text/x-wiki __NOTOC__ The following is a complete example to illustrate how the xml.pl module can be used. It exercises both the input and output parsing modes of <code>xml_parse/[2,3]</code>, and illustrates the use of <code>xml_subterm/2</code> to access the nodes of a "document value model". It's written for Quintus Prolog, but should port to other Prologs easily. the <code>test/1</code> predicate is the entry-point of the program. ====test( +QueryId )==== executes a Prolog implementation of a Query from [http://www.w3.org/TR/xquery-use-cases/#xmp Use Case "XMP": Experiences and Exemplars], in the W3C's XML Query Use Cases, which "contains several example queries that illustrate requirements gathered from the database and document communities". <var>QueryId</var> is one of <code>q1</code>...<code>q12</code> selecting which of the 12 use cases is executed. The XML output is written to the file [QueryId].xml in the current directory. <code>xml_pp/1</code> is used to display the resulting "document value model" data-structures on the user output (stdout) stream. <syntaxhighlight lang="prolog">test( Query ) :- xml_query( Query, ResultElement ), % Parse output XML into the Output chars xml_parse( Output, xml([], [ResultElement]) ), absolute_file_name( Query, [extensions(xml)], OutputFile ), % Write OutputFile from the Output list of chars tell( OutputFile ), put_chars( Output ), told, % Pretty print OutputXML write( 'Output XML' ), nl, xml_pp( xml([], [ResultElement]) ).</syntaxhighlight> ====xml_query( +QueryNo, ?OutputXML )==== when <var>OutputXML</var> is an XML Document Value Model produced by running an example, identified by <var>QueryNo</var>, taken from the XML Query "XMP" use case. ===Q1=== List books published by Addison-Wesley after 1991, including their year and title. <syntaxhighlight lang="prolog">xml_query( q1, element(bib, [], Books) ) :- element_name( Title, title ), element_name( Publisher, publisher ), input_document( 'bib.xml', Bibliography ), findall( element(book, [year=Year], [Title]), ( xml_subterm( Bibliography, element(book, Attributes, Content) ), xml_subterm( Content, Publisher ), xml_subterm( Publisher, Text ), text_value( Text, "Addison-Wesley" ), member( year=Year, Attributes ), number_codes( YearNo, Year ), YearNo > 1991, xml_subterm( Content, Title ) ), Books ).</syntaxhighlight> ===Q2=== Create a flat list of all the title-author pairs, with each pair enclosed in a "result" element. <syntaxhighlight lang="prolog">xml_query( q2, element(results, [], Results) ) :- element_name( Title, title ), element_name( Author, author ), element_name( Book, book ), input_document( 'bib.xml', Bibliography ), findall( element(result, [], [Title,Author]), ( xml_subterm( Bibliography, Book ), xml_subterm( Book, Title ), xml_subterm( Book, Author ) ), Results ).</syntaxhighlight> ===Q3=== For each book in the bibliography, list the title and authors, grouped inside a "result" element. <syntaxhighlight lang="prolog">xml_query( q3, element(results, [], Results) ) :- element_name( Title, title ), element_name( Author, author ), element_name( Book, book ), input_document( 'bib.xml', Bibliography ), findall( element(result, [], [Title|Authors]), ( xml_subterm( Bibliography, Book ), xml_subterm( Book, Title ), findall( Author, xml_subterm(Book, Author), Authors ) ), Results ).</syntaxhighlight> ===Q4=== For each author in the bibliography, list the author's name and the titles of all books by that author, grouped inside a "result" element. <syntaxhighlight lang="prolog">xml_query( q4, element(results, [], Results) ) :- element_name( Title, title ), element_name( Author, author ), element_name( Book, book ), input_document( 'bib.xml', Bibliography ), findall( Author, xml_subterm(Bibliography, Author), AuthorBag ), sort( AuthorBag, Authors ), findall( element(result, [], [Author|Titles]), ( member( Author, Authors ), findall( Title, ( xml_subterm( Bibliography, Book ), xml_subterm( Book, Author ), xml_subterm( Book, Title ) ), Titles ) ), Results ).</syntaxhighlight> ===Q5=== For each book found at both bn.com and amazon.com, list the title of the book and its price from each source. <syntaxhighlight lang="prolog">xml_query( q5, element('books-with-prices', [], BooksWithPrices) ) :- element_name( Title, title ), element_name( Book, book ), element_name( Review, entry ), input_document( 'bib.xml', Bibliography ), input_document( 'reviews.xml', Reviews ), findall( element('book-with-prices', [], [ Title, element('price-bn',[], BNPrice ), element('price-amazon',[], AmazonPrice ) ] ), ( xml_subterm( Bibliography, Book ), xml_subterm( Book, Title ), xml_subterm( Reviews, Review ), xml_subterm( Review, Title ), xml_subterm( Book, element(price,_, BNPrice) ), xml_subterm( Review, element(price,_, AmazonPrice) ) ), BooksWithPrices ).</syntaxhighlight> ===Q6=== For each book that has at least one author, list the title and first two authors, and an empty "et-al" element if the book has additional authors. <syntaxhighlight lang="prolog">xml_query( q6, element(bib, [], Results) ) :- element_name( Title, title ), element_name( Author, author ), element_name( Book, book ), input_document( 'bib.xml', Bibliography ), findall( element(book, [], [Title,FirstAuthor|Authors]), ( xml_subterm( Bibliography, Book ), xml_subterm( Book, Title ), findall( Author, xml_subterm(Book, Author), [FirstAuthor|Others] ), other_authors( Others, Authors ) ), Results ).</syntaxhighlight> ===Q7=== List the titles and years of all books published by Addison-Wesley after 1991, in alphabetic order. <syntaxhighlight lang="prolog">xml_query( q7, element(bib, [], Books) ) :- element_name( Title, title ), element_name( Publisher, publisher ), input_document( 'bib.xml', Bibliography ), findall( Title-element(book, [year=Year], [Title]), ( xml_subterm( Bibliography, element(book, Attributes, Book) ), xml_subterm( Book, Publisher ), xml_subterm( Publisher, Text ), text_value( Text, "Addison-Wesley" ), member( year=Year, Attributes ), number_codes( YearNo, Year ), YearNo > 1991, xml_subterm( Book, Title ) ), TitleBooks ), keysort( TitleBooks, TitleBookSet ), range( TitleBookSet, Books ).</syntaxhighlight> ===Q8=== Find books in which the name of some element ends with the string "or" and the same element contains the string "Suciu" somewhere in its content. For each such book, return the title and the qualifying element. <syntaxhighlight lang="prolog">xml_query( q8, element(bib, [], Books) ) :- element_name( Title, title ), element_name( Book, book ), element_name( QualifyingElement, QualifyingName ), append( "Suciu", _Back, Suffix ), input_document( 'bib.xml', Bibliography ), findall( element(book, [], [Title,QualifyingElement]), ( xml_subterm( Bibliography, Book ), xml_subterm( Book, QualifyingElement ), atom_codes( QualifyingName, QNChars ), append( _QNPrefix, "or", QNChars ), xml_subterm( QualifyingElement, TextItem ), text_value( TextItem, TextValue ), append( _Prefix, Suffix, TextValue ), xml_subterm( Book, Title ) ), Books ).</syntaxhighlight> ===Q9=== In the document "books.xml", find all section or chapter titles that contain the word "XML", regardless of the level of nesting. <syntaxhighlight lang="prolog">xml_query( q9, element(results, [], Titles) ) :- element_name( Title, title ), append( "XML", _Back, Suffix ), input_document( 'books.xml', Books ), findall( Title, ( xml_subterm( Books, Title ), xml_subterm( Title, TextItem ), text_value( TextItem, TextValue ), append( _Prefix, Suffix, TextValue ) ), Titles ).</syntaxhighlight> ===Q10=== In the document "prices.xml", find the minimum price for each book, in the form of a "minprice" element with the book title as its title attribute. <syntaxhighlight lang="prolog">xml_query( q10, element(results, [], MinPrices) ) :- element_name( Title, title ), element_name( Price, price ), input_document( 'prices.xml', Prices ), findall( Title, xml_subterm(Prices, Title), TitleBag ), sort( TitleBag, TitleSet ), element_name( Book, book ), findall( element(minprice, [title=TitleString], [MinPrice]), ( member( Title, TitleSet ), xml_subterm( Title, TitleText ), text_value( TitleText, TitleString ), findall( PriceValue-Price, ( xml_subterm( Prices, Book ), xml_subterm( Book, Title ), xml_subterm( Book, Price ), xml_subterm( Price, Text ), text_value( Text, PriceChars ), number_codes( PriceValue, PriceChars ) ), PriceValues ), minimum( PriceValues, PriceValue-MinPrice ) ), MinPrices ).</syntaxhighlight> ===Q11=== For each book with an author, return the book with its title and authors. For each book with an editor, return a reference with the book title and the editor's affiliation. <syntaxhighlight lang="prolog">xml_query( q11, element(bib, [], Results) ) :- element_name( Title, title ), element_name( Author, author ), element_name( Book, book ), element_name( Editor, editor ), element_name( Affiliation, affiliation ), input_document( 'bib.xml', Bibliography ), findall( element(book, [], [Title,FirstAuthor|Authors]), ( xml_subterm( Bibliography, Book ), xml_subterm( Book, Title ), findall( Author, xml_subterm(Book, Author), [FirstAuthor|Authors] ) ), Books ), findall( element(reference, [], [Title,Affiliation]), ( xml_subterm( Bibliography, Book ), xml_subterm( Book, Title ), xml_subterm( Book, Editor ), xml_subterm( Editor, Affiliation ) ), References ), append( Books, References, Results ).</syntaxhighlight> ===Q12=== Find pairs of books that have different titles but the same set of authors (possibly in a different order). <syntaxhighlight lang="prolog">xml_query( q12, element(bib, [], Pairs) ) :- element_name( Author, author ), element_name( Book1, book ), element_name( Book2, book ), element_name( Title1, title ), element_name( Title2, title ), input_document( 'bib.xml', Bibliography ), findall( element('book-pair', [], [Title1,Title2]), ( xml_subterm( Bibliography, Book1 ), findall( Author, xml_subterm(Book1, Author), AuthorBag1 ), sort( AuthorBag1, AuthorSet ), xml_subterm( Bibliography, Book2 ), Book2 @< Book1, findall( Author, xml_subterm(Book2, Author), AuthorBag2 ), sort( AuthorBag2, AuthorSet ), xml_subterm( Book1, Title1 ), xml_subterm( Book2, Title2 ) ), Pairs ).</syntaxhighlight> == Auxiliary Predicates == <syntaxhighlight lang="prolog">other_authors( [], [] ). other_authors( [Author|Authors], [Author|EtAl] ) :- et_al( Authors, EtAl ). et_al( [], [] ). et_al( [_|_], [element('et-al',[],[])] ). text_value( [pcdata(Text)], Text ). text_value( [cdata(Text)], Text ). element_name( element(Name, _Attributes, _Content), Name ).</syntaxhighlight> ====range( +Pairs, ?Range )==== when <var>Pairs</var> is a list of key-datum pairs and <var>Range</var> is the list of data. <syntaxhighlight lang="prolog">range( [], [] ). range( [_Key-Datum|Pairs], [Datum|Data] ) :- range( Pairs, Data ).</syntaxhighlight> ====minimum( +List, ?Min )==== is true if <var>Min</var> is the least member of <var>List</var> in the standard order. <syntaxhighlight lang="prolog">minimum( [H|T], Min ):- minimum1( T, H, Min ). minimum1( [], Min, Min ). minimum1( [H|T], Min0, Min ) :- compare( Relation, H, Min0 ), minimum2( Relation, H, Min0, T, Min ). minimum2( '=', Min0, Min0, T, Min ) :- minimum1( T, Min0, Min ). minimum2( '<', Min0, _Min1, T, Min ) :- minimum1( T, Min0, Min ). minimum2( '>', _Min0, Min1, T, Min ) :- minimum1( T, Min1, Min ).</syntaxhighlight> ====input_document( +File, ?XML )==== reads <var>File</var> and parses the input into the "Document Value Model" <var>XML</var>. <syntaxhighlight lang="prolog">input_document( File, XML ) :- % Read InputFile as a list of chars see( File ), get_chars( Input ), seen, % Parse the Input chars into the term XML xml_parse( Input, XML ).</syntaxhighlight> Load the [[XML Module]]. <syntaxhighlight lang="prolog">:- use_module( xml ).</syntaxhighlight> Load a small library of [[Puzzle Utilities]]. <syntaxhighlight lang="prolog"> :- ensure_loaded( misc ). </syntaxhighlight> Download a 5Kb tar.gz format [https://binding-time.co.uk/download/xml_example.tar.gz file containing this program with input and output data]. 99143083a6cac6af126944d87b0eb3a2360ebb00 86 75 2014-11-08T18:32:04Z John 2 wikitext text/x-wiki __NOTOC__ The following is a complete example to illustrate how the xml.pl module can be used. It exercises both the input and output parsing modes of <code>xml_parse/[2,3]</code>, and illustrates the use of <code>xml_subterm/2</code> to access the nodes of a "document value model". It's written for Quintus Prolog, but should port to other Prologs easily. ====test( +QueryId )==== The <code>test/1</code> predicate is the entry-point of the program and executes a Prolog implementation of a Query from [http://www.w3.org/TR/xquery-use-cases/#xmp Use Case "XMP": Experiences and Exemplars], in the W3C's XML Query Use Cases, which "contains several example queries that illustrate requirements gathered from the database and document communities". <var>QueryId</var> is one of <code>q1</code>...<code>q12</code> selecting which of the 12 use cases is executed. The XML output is written to the file [QueryId].xml in the current directory. <code>xml_pp/1</code> is used to display the resulting "document value model" data-structures on the user output (stdout) stream. <syntaxhighlight lang="prolog">test( Query ) :- xml_query( Query, ResultElement ), % Parse output XML into the Output chars xml_parse( Output, xml([], [ResultElement]) ), absolute_file_name( Query, [extensions(xml)], OutputFile ), % Write OutputFile from the Output list of chars tell( OutputFile ), put_chars( Output ), told, % Pretty print OutputXML write( 'Output XML' ), nl, xml_pp( xml([], [ResultElement]) ).</syntaxhighlight> ====xml_query( +QueryNo, ?OutputXML )==== when <var>OutputXML</var> is an XML Document Value Model produced by running an example, identified by <var>QueryNo</var>, taken from the XML Query "XMP" use case. ===Q1=== List books published by Addison-Wesley after 1991, including their year and title. <syntaxhighlight lang="prolog">xml_query( q1, element(bib, [], Books) ) :- element_name( Title, title ), element_name( Publisher, publisher ), input_document( 'bib.xml', Bibliography ), findall( element(book, [year=Year], [Title]), ( xml_subterm( Bibliography, element(book, Attributes, Content) ), xml_subterm( Content, Publisher ), xml_subterm( Publisher, Text ), text_value( Text, "Addison-Wesley" ), member( year=Year, Attributes ), number_codes( YearNo, Year ), YearNo > 1991, xml_subterm( Content, Title ) ), Books ).</syntaxhighlight> ===Q2=== Create a flat list of all the title-author pairs, with each pair enclosed in a "result" element. <syntaxhighlight lang="prolog">xml_query( q2, element(results, [], Results) ) :- element_name( Title, title ), element_name( Author, author ), element_name( Book, book ), input_document( 'bib.xml', Bibliography ), findall( element(result, [], [Title,Author]), ( xml_subterm( Bibliography, Book ), xml_subterm( Book, Title ), xml_subterm( Book, Author ) ), Results ).</syntaxhighlight> ===Q3=== For each book in the bibliography, list the title and authors, grouped inside a "result" element. <syntaxhighlight lang="prolog">xml_query( q3, element(results, [], Results) ) :- element_name( Title, title ), element_name( Author, author ), element_name( Book, book ), input_document( 'bib.xml', Bibliography ), findall( element(result, [], [Title|Authors]), ( xml_subterm( Bibliography, Book ), xml_subterm( Book, Title ), findall( Author, xml_subterm(Book, Author), Authors ) ), Results ).</syntaxhighlight> ===Q4=== For each author in the bibliography, list the author's name and the titles of all books by that author, grouped inside a "result" element. <syntaxhighlight lang="prolog">xml_query( q4, element(results, [], Results) ) :- element_name( Title, title ), element_name( Author, author ), element_name( Book, book ), input_document( 'bib.xml', Bibliography ), findall( Author, xml_subterm(Bibliography, Author), AuthorBag ), sort( AuthorBag, Authors ), findall( element(result, [], [Author|Titles]), ( member( Author, Authors ), findall( Title, ( xml_subterm( Bibliography, Book ), xml_subterm( Book, Author ), xml_subterm( Book, Title ) ), Titles ) ), Results ).</syntaxhighlight> ===Q5=== For each book found at both bn.com and amazon.com, list the title of the book and its price from each source. <syntaxhighlight lang="prolog">xml_query( q5, element('books-with-prices', [], BooksWithPrices) ) :- element_name( Title, title ), element_name( Book, book ), element_name( Review, entry ), input_document( 'bib.xml', Bibliography ), input_document( 'reviews.xml', Reviews ), findall( element('book-with-prices', [], [ Title, element('price-bn',[], BNPrice ), element('price-amazon',[], AmazonPrice ) ] ), ( xml_subterm( Bibliography, Book ), xml_subterm( Book, Title ), xml_subterm( Reviews, Review ), xml_subterm( Review, Title ), xml_subterm( Book, element(price,_, BNPrice) ), xml_subterm( Review, element(price,_, AmazonPrice) ) ), BooksWithPrices ).</syntaxhighlight> ===Q6=== For each book that has at least one author, list the title and first two authors, and an empty "et-al" element if the book has additional authors. <syntaxhighlight lang="prolog">xml_query( q6, element(bib, [], Results) ) :- element_name( Title, title ), element_name( Author, author ), element_name( Book, book ), input_document( 'bib.xml', Bibliography ), findall( element(book, [], [Title,FirstAuthor|Authors]), ( xml_subterm( Bibliography, Book ), xml_subterm( Book, Title ), findall( Author, xml_subterm(Book, Author), [FirstAuthor|Others] ), other_authors( Others, Authors ) ), Results ).</syntaxhighlight> ===Q7=== List the titles and years of all books published by Addison-Wesley after 1991, in alphabetic order. <syntaxhighlight lang="prolog">xml_query( q7, element(bib, [], Books) ) :- element_name( Title, title ), element_name( Publisher, publisher ), input_document( 'bib.xml', Bibliography ), findall( Title-element(book, [year=Year], [Title]), ( xml_subterm( Bibliography, element(book, Attributes, Book) ), xml_subterm( Book, Publisher ), xml_subterm( Publisher, Text ), text_value( Text, "Addison-Wesley" ), member( year=Year, Attributes ), number_codes( YearNo, Year ), YearNo > 1991, xml_subterm( Book, Title ) ), TitleBooks ), keysort( TitleBooks, TitleBookSet ), range( TitleBookSet, Books ).</syntaxhighlight> ===Q8=== Find books in which the name of some element ends with the string "or" and the same element contains the string "Suciu" somewhere in its content. For each such book, return the title and the qualifying element. <syntaxhighlight lang="prolog">xml_query( q8, element(bib, [], Books) ) :- element_name( Title, title ), element_name( Book, book ), element_name( QualifyingElement, QualifyingName ), append( "Suciu", _Back, Suffix ), input_document( 'bib.xml', Bibliography ), findall( element(book, [], [Title,QualifyingElement]), ( xml_subterm( Bibliography, Book ), xml_subterm( Book, QualifyingElement ), atom_codes( QualifyingName, QNChars ), append( _QNPrefix, "or", QNChars ), xml_subterm( QualifyingElement, TextItem ), text_value( TextItem, TextValue ), append( _Prefix, Suffix, TextValue ), xml_subterm( Book, Title ) ), Books ).</syntaxhighlight> ===Q9=== In the document "books.xml", find all section or chapter titles that contain the word "XML", regardless of the level of nesting. <syntaxhighlight lang="prolog">xml_query( q9, element(results, [], Titles) ) :- element_name( Title, title ), append( "XML", _Back, Suffix ), input_document( 'books.xml', Books ), findall( Title, ( xml_subterm( Books, Title ), xml_subterm( Title, TextItem ), text_value( TextItem, TextValue ), append( _Prefix, Suffix, TextValue ) ), Titles ).</syntaxhighlight> ===Q10=== In the document "prices.xml", find the minimum price for each book, in the form of a "minprice" element with the book title as its title attribute. <syntaxhighlight lang="prolog">xml_query( q10, element(results, [], MinPrices) ) :- element_name( Title, title ), element_name( Price, price ), input_document( 'prices.xml', Prices ), findall( Title, xml_subterm(Prices, Title), TitleBag ), sort( TitleBag, TitleSet ), element_name( Book, book ), findall( element(minprice, [title=TitleString], [MinPrice]), ( member( Title, TitleSet ), xml_subterm( Title, TitleText ), text_value( TitleText, TitleString ), findall( PriceValue-Price, ( xml_subterm( Prices, Book ), xml_subterm( Book, Title ), xml_subterm( Book, Price ), xml_subterm( Price, Text ), text_value( Text, PriceChars ), number_codes( PriceValue, PriceChars ) ), PriceValues ), minimum( PriceValues, PriceValue-MinPrice ) ), MinPrices ).</syntaxhighlight> ===Q11=== For each book with an author, return the book with its title and authors. For each book with an editor, return a reference with the book title and the editor's affiliation. <syntaxhighlight lang="prolog">xml_query( q11, element(bib, [], Results) ) :- element_name( Title, title ), element_name( Author, author ), element_name( Book, book ), element_name( Editor, editor ), element_name( Affiliation, affiliation ), input_document( 'bib.xml', Bibliography ), findall( element(book, [], [Title,FirstAuthor|Authors]), ( xml_subterm( Bibliography, Book ), xml_subterm( Book, Title ), findall( Author, xml_subterm(Book, Author), [FirstAuthor|Authors] ) ), Books ), findall( element(reference, [], [Title,Affiliation]), ( xml_subterm( Bibliography, Book ), xml_subterm( Book, Title ), xml_subterm( Book, Editor ), xml_subterm( Editor, Affiliation ) ), References ), append( Books, References, Results ).</syntaxhighlight> ===Q12=== Find pairs of books that have different titles but the same set of authors (possibly in a different order). <syntaxhighlight lang="prolog">xml_query( q12, element(bib, [], Pairs) ) :- element_name( Author, author ), element_name( Book1, book ), element_name( Book2, book ), element_name( Title1, title ), element_name( Title2, title ), input_document( 'bib.xml', Bibliography ), findall( element('book-pair', [], [Title1,Title2]), ( xml_subterm( Bibliography, Book1 ), findall( Author, xml_subterm(Book1, Author), AuthorBag1 ), sort( AuthorBag1, AuthorSet ), xml_subterm( Bibliography, Book2 ), Book2 @< Book1, findall( Author, xml_subterm(Book2, Author), AuthorBag2 ), sort( AuthorBag2, AuthorSet ), xml_subterm( Book1, Title1 ), xml_subterm( Book2, Title2 ) ), Pairs ).</syntaxhighlight> == Auxiliary Predicates == <syntaxhighlight lang="prolog">other_authors( [], [] ). other_authors( [Author|Authors], [Author|EtAl] ) :- et_al( Authors, EtAl ). et_al( [], [] ). et_al( [_|_], [element('et-al',[],[])] ). text_value( [pcdata(Text)], Text ). text_value( [cdata(Text)], Text ). element_name( element(Name, _Attributes, _Content), Name ).</syntaxhighlight> ====range( +Pairs, ?Range )==== when <var>Pairs</var> is a list of key-datum pairs and <var>Range</var> is the list of data. <syntaxhighlight lang="prolog">range( [], [] ). range( [_Key-Datum|Pairs], [Datum|Data] ) :- range( Pairs, Data ).</syntaxhighlight> ====minimum( +List, ?Min )==== is true if <var>Min</var> is the least member of <var>List</var> in the standard order. <syntaxhighlight lang="prolog">minimum( [H|T], Min ):- minimum1( T, H, Min ). minimum1( [], Min, Min ). minimum1( [H|T], Min0, Min ) :- compare( Relation, H, Min0 ), minimum2( Relation, H, Min0, T, Min ). minimum2( '=', Min0, Min0, T, Min ) :- minimum1( T, Min0, Min ). minimum2( '<', Min0, _Min1, T, Min ) :- minimum1( T, Min0, Min ). minimum2( '>', _Min0, Min1, T, Min ) :- minimum1( T, Min1, Min ).</syntaxhighlight> ====input_document( +File, ?XML )==== reads <var>File</var> and parses the input into the "Document Value Model" <var>XML</var>. <syntaxhighlight lang="prolog">input_document( File, XML ) :- % Read InputFile as a list of chars see( File ), get_chars( Input ), seen, % Parse the Input chars into the term XML xml_parse( Input, XML ).</syntaxhighlight> Load the [[XML Module]]. <syntaxhighlight lang="prolog">:- use_module( xml ).</syntaxhighlight> Load a small library of [[Puzzle Utilities]]. <syntaxhighlight lang="prolog"> :- ensure_loaded( misc ). </syntaxhighlight> Download a 5Kb tar.gz format [https://binding-time.co.uk/download/xml_example.tar.gz file containing this program with input and output data]. 9945a1bb4b2c9db73f42b0358b910c0ecd0febdb 0 19 77 2014-06-07T11:17:45Z John 2 Created page with "__NOTOC__ == Prolog for the Worldwide Web == For a Prolog programmer, to suggest that Prolog is an ideal language for web-based applications is to invite the comment that, &q..." wikitext text/x-wiki __NOTOC__ == Prolog for the Worldwide Web == For a Prolog programmer, to suggest that Prolog is an ideal language for web-based applications is to invite the comment that, &quot;if you have only a hammer, everything looks like a nail&quot;. However, the correspondences between Prolog behaviour and HTTP, and Prolog data-structures and XML are so strong that it's fair to say that ''if Prolog is a hand, the Worldwide Web is a glove.'' == HTTP == Consider that Prolog's default behaviour is &quot;query-solving&quot; - where a query is posed for which arbitrarily many &quot;answers&quot; (solutions) may be returned. This can be mapped to HTTP's request/response mechanism straightforwardly: === HTTP GET === The HTTP GET verb has a clear correspondence with Prolog's notion of a &quot;query&quot;. In fact, Prolog can be used directly as part of a request URI, acting as a lightweight data-structuring mechanism. However, HTTP requires each request/response to be deterministic, which suggests that ''all'' the solutions for a non-deterministic query should be returned. The solutions can be formatted as an XHTML list or table, for example. === Caching === Prolog programming allows for the 'caching' of expensive results using &quot;lemmas&quot;, a technique used in the solution of the [[Mister X#Lemmas|Mister X]] puzzle, for example. HTTP's 'HEAD' verb, (and GET with &quot;If-Modified-Since&quot;) support caching mechanisms, primarily to save communications bandwidth. The integration of Prolog &quot;lemmas&quot; with HTTP's caching methods can save both bandwidth and recomputation through a single mechanism, enabling the creation of robust distributed applications with a minimum of fuss. === HTTP POST === When using Prolog with HTTP, the POST verb should be reserved for passing ''clauses'' from the client to the server, to update the server, not for queries. The fact that Prolog is a good format for including structured (composite) data items as part of a URI can obviate some inappropriate uses of HTTP's POST verb, by allowing more complex terms in GET requests. == XML == HTTP services in which both the client and server are Prolog programs can gain efficiency by exchanging Prolog terms in URIs and results, using Prolog's term I/O facilities. However, XML is becoming established as the preferred format for data exchange in heterogeneous distributed applications. XML data is represented easily in Prolog, and vice versa, because both use tree-structured data exclusively. Because Prolog is a very high-level language, it is more flexible and more powerful than [http://www.w3.org/TR/xslt XSLT]. In particular, it seems to be very much easier to create robust, reliable transformations with Prolog, i.e. ones that produce only valid output for any valid input. ===xml.pl=== xml.pl is a module for [[parsing XML with Prolog]]. It has been placed in the public domain to encourage the use of Prolog with XML. ==PiLLoW== The [http://clip.dia.fi.upm.es/miscdocs/pillow/pillow.html PiLLoW] library provides predicates for developing HTTP client and server applications. For client applications, it provides mechanisms to retrieve HTML files and to parse HTML into useful Prolog terms. For server applications it provides a predicate to access CGI query parameters, so that a Prolog application can be used to handle form input directly i.e. without additional scripting. Additionally, HTML parsing supports the reverse translation of terms into HTML, so that forms can be generated. See also, [[Porting PiLLoW to Quintus Prolog]]. 7dc8214f7d96ad5ba9903ad716e0176f3ea3332a 0 20 78 2014-06-07T11:18:55Z John 2 Created page with "== Porting PiLLoW to Quintus Prolog 3.X == The [http://clip.dia.fi.upm.es/miscdocs/pillow/pillow.html PiLLoW] library provides predicates for developing HTTP client and serve..." wikitext text/x-wiki == Porting PiLLoW to Quintus Prolog 3.X == The [http://clip.dia.fi.upm.es/miscdocs/pillow/pillow.html PiLLoW] library provides predicates for developing HTTP client and server applications. For client applications, it provides mechanisms to retrieve HTML files and to parse HTML into useful Prolog terms. For server applications it provides a predicate to access CGI query parameters, so that a Prolog application can be used to handle form input directly i.e. without additional scripting. Additionally, HTML parsing supports the reverse translation of terms into HTML, so that forms can be generated. ==PiLLoW 1.1== If you want to port [http://clip.dia.fi.upm.es/miscdocs/pillow/pillow.html PiLLoW 1.1] to [http://quintus.sics.se/ Quintus Prolog], the following notes may be of use. ===http_transaction/5=== must be rewritten to use the Quintus tcp and socketio libraries. ====http_transaction(+Host, +Port, +Request, +Timeout, -Response)==== Sends an HTTP Request to an HTTP server <code>(Host:Port)</code> and returns the resultant message in Response. <syntaxhighlight lang="prolog"> :- use_module(library(tcp)). :- use_module(library(socketio)). :- use_module(library(date), [now/1]). http_transaction( Host, Port, Request, Timeout, Response ) :- tcp:connect( Host, Port, Socket ), Socket >= 0, % Fail if connect error socket_io_open_output( Socket, Ocode ), stream_code( OStream, Ocode ), write_string( OStream, Request ), close( OStream ), socket_io_open_input( Socket, Icode ), stream_code( IStream, Icode ), now( Now ), http_transaction1( Now, Socket, IStream, Timeout, Response ), close( IStream ), tcp:tcp_shutdown( Socket, _Status ), Response \== timeout. http_transaction1( Now, Socket, IStream, Timeout, Response ) :- tcp:tcp_select( 0, Timeout, FD, Status ), http_transaction2( Status, Now, Socket, FD, IStream, Timeout, Response ). http_transaction2( 1, Then, Socket, FD, IStream, Timeout, Response ) :- ( Socket == FD -> stream_to_string( IStream, Response ) ; otherwise -> now( Now ), Elapsed is Now - Then, ( Elapsed < Timeout -> Timeout1 is Timeout - Elapsed, http_transaction1( Now, Socket, IStream, Timeout1, Response ) ; otherwise -> Response = timeout ) ). http_transaction2( 0, _Then, _Socket, _FD, _IStream, _Timeout, timeout ). http_transaction2( -1, _Then, Socket, _FD, IStream, Timeout, _Response ) :- raise_exception( socket_error(Socket, IStream, Timeout) ). getenvstr( Var, Chars ) :- environ( Var, Atom ), atom_chars( Atom, Chars ). :- use_module( library(environ), [environ/2] ). </syntaxhighlight> The ISO Prolog predicates used in PiLLoW can be mapped to equivalent Quintus built-in predicates. <syntaxhighlight lang="prolog">flush_output :- ttyflush. atom_codes( Atom, Codes ) :- atom_chars( Atom, Codes ). catch( Goal, Error, Action ) :- on_exception( Error, Goal, Action ). get_code( Code ) :- get0( Code ). get_code( Stream, Code ) :- get0( Stream, Code ). include( File ) :- ensure_loaded( File ). number_codes( Number, Codes ) :- number_chars( Number, Codes ). put_code( Code ) :- put( Code ).</syntaxhighlight> Similarly, some library predicates are not defined/defined differently in Quintus: <syntaxhighlight lang="prolog">atom_concat( A, B, AB ) :- name( A, AS ), name( B, BS ), append( AS, BS, ABS ), atom_chars( AB, ABS ). getenv( Var, QueryString ) :- environ( Var, QueryString ). :- use_module( library(environ), [environ/2] ).</syntaxhighlight> ==Pillow 1.0== I have ported PiLLoW 1.0 to use the [http://quintus.sics.se/ Quintus Prolog] 3.X libraries, and made it available as a [https://binding-time.co.uk/download/pillow.zip 260Kb Zip file]. It is offered here as free, '''unsupported''' source code, for which the author accepts no liability whatsoever. '''''Note:''''' The parsing of &quot;multipart&quot; form data on win32 can produce errors, when binary files are submitted, e.g. sending image files as part of the form input. This is because the default for &quot;stdin&quot; on win32 is &quot;text&quot;. b37656ba2bd7e9325e705069673156b555b589e1 79 78 2014-06-08T21:39:18Z John 2 /* http_transaction/5 */ wikitext text/x-wiki == Porting PiLLoW to Quintus Prolog 3.X == The [http://clip.dia.fi.upm.es/miscdocs/pillow/pillow.html PiLLoW] library provides predicates for developing HTTP client and server applications. For client applications, it provides mechanisms to retrieve HTML files and to parse HTML into useful Prolog terms. For server applications it provides a predicate to access CGI query parameters, so that a Prolog application can be used to handle form input directly i.e. without additional scripting. Additionally, HTML parsing supports the reverse translation of terms into HTML, so that forms can be generated. ==PiLLoW 1.1== If you want to port [http://clip.dia.fi.upm.es/miscdocs/pillow/pillow.html PiLLoW 1.1] to [http://quintus.sics.se/ Quintus Prolog], the following notes may be of use. ===http_transaction/5=== must be rewritten to use the Quintus tcp and socketio libraries. ====http_transaction(+Host, +Port, +Request, +Timeout, -Response)==== Sends an HTTP <var>Request</var> to an HTTP server <var>Host</var>:<var>Port</var> and returns the resulting message in <var>Response</var>. <var>Timeout</var> defines the maximum number of seconds to wait for a response. <syntaxhighlight lang="prolog"> :- use_module(library(tcp)). :- use_module(library(socketio)). :- use_module(library(date), [now/1]). http_transaction( Host, Port, Request, Timeout, Response ) :- tcp:connect( Host, Port, Socket ), Socket >= 0, % Fail if connect error socket_io_open_output( Socket, Ocode ), stream_code( OStream, Ocode ), write_string( OStream, Request ), close( OStream ), socket_io_open_input( Socket, Icode ), stream_code( IStream, Icode ), now( Now ), http_transaction1( Now, Socket, IStream, Timeout, Response ), close( IStream ), tcp:tcp_shutdown( Socket, _Status ), Response \== timeout. http_transaction1( Now, Socket, IStream, Timeout, Response ) :- tcp:tcp_select( 0, Timeout, FD, Status ), http_transaction2( Status, Now, Socket, FD, IStream, Timeout, Response ). http_transaction2( 1, Then, Socket, FD, IStream, Timeout, Response ) :- ( Socket == FD -> stream_to_string( IStream, Response ) ; otherwise -> now( Now ), Elapsed is Now - Then, ( Elapsed < Timeout -> Timeout1 is Timeout - Elapsed, http_transaction1( Now, Socket, IStream, Timeout1, Response ) ; otherwise -> Response = timeout ) ). http_transaction2( 0, _Then, _Socket, _FD, _IStream, _Timeout, timeout ). http_transaction2( -1, _Then, Socket, _FD, IStream, Timeout, _Response ) :- raise_exception( socket_error(Socket, IStream, Timeout) ). getenvstr( Var, Chars ) :- environ( Var, Atom ), atom_chars( Atom, Chars ). :- use_module( library(environ), [environ/2] ). </syntaxhighlight> The ISO Prolog predicates used in PiLLoW can be mapped to equivalent Quintus built-in predicates. <syntaxhighlight lang="prolog">flush_output :- ttyflush. atom_codes( Atom, Codes ) :- atom_chars( Atom, Codes ). catch( Goal, Error, Action ) :- on_exception( Error, Goal, Action ). get_code( Code ) :- get0( Code ). get_code( Stream, Code ) :- get0( Stream, Code ). include( File ) :- ensure_loaded( File ). number_codes( Number, Codes ) :- number_chars( Number, Codes ). put_code( Code ) :- put( Code ).</syntaxhighlight> Similarly, some library predicates are not defined/defined differently in Quintus: <syntaxhighlight lang="prolog">atom_concat( A, B, AB ) :- name( A, AS ), name( B, BS ), append( AS, BS, ABS ), atom_chars( AB, ABS ). getenv( Var, QueryString ) :- environ( Var, QueryString ). :- use_module( library(environ), [environ/2] ).</syntaxhighlight> ==Pillow 1.0== I have ported PiLLoW 1.0 to use the [http://quintus.sics.se/ Quintus Prolog] 3.X libraries, and made it available as a [https://binding-time.co.uk/download/pillow.zip 260Kb Zip file]. It is offered here as free, '''unsupported''' source code, for which the author accepts no liability whatsoever. '''''Note:''''' The parsing of &quot;multipart&quot; form data on win32 can produce errors, when binary files are submitted, e.g. sending image files as part of the form input. This is because the default for &quot;stdin&quot; on win32 is &quot;text&quot;. ce7869fe94ddaf60d70f57f03c4aa493d90ec03b 4 21 81 2014-06-30T22:55:19Z John 2 Created page with "== Statement == The following statement explains how your information will be treated as you make use of the my web-site - binding-time.co.uk. It applies to all the public ar..." wikitext text/x-wiki == Statement == The following statement explains how your information will be treated as you make use of the my web-site - binding-time.co.uk. It applies to all the public areas of the binding-time.co.uk web-site. binding-time.co.uk does not collect or store any information to identify you individually. The Mediawiki software used by binding-time.co.uk employs cookies for session management. No other cookies are used by binding-time.co.uk. I am not responsible for the privacy practices of external web-sites. A link from binding-time.co.uk to an external site is not an endorsement of that site's privacy policy. == Information Collected == The that is provided automatically by a browser is recorded in server logs and may be used for traffic analysis. This information includes: === User-Agent === Software programs that allow users to access documents on the World Wide Web are known as User-Agents. Typically these will be &quot;browsers&quot;, such as Mozilla Firefox or Microsoft Internet Explorer. Most User-Agents provide information about the type and version of both the user agent software and the operating system of the computer on which it runs. This information is provided automatically to every web-site the user visits. === IP Address === This is a unique numeric address assigned to each computer connected to the Internet and is provided automatically to every web-site the user visits. Usually, IP Addresses can be resolved to domain names, which may identify an Internet Service Provider (ISP), employer, university, etc. === Referrer === The referrer is the URL (address) of the page from which a request originated and is provided automatically by the User Agent (browser). 18690e7bc1c26460c51606665a55527edd1b9787 82 81 2014-06-30T22:55:56Z John 2 /* Statement */ wikitext text/x-wiki == Statement == The following statement explains how your information will be treated as you make use of my web-site - binding-time.co.uk. It applies to all the public areas of the binding-time.co.uk web-site. binding-time.co.uk does not collect or store any information to identify you individually. The Mediawiki software used by binding-time.co.uk employs cookies for session management. No other cookies are used by binding-time.co.uk. I am not responsible for the privacy practices of external web-sites. A link from binding-time.co.uk to an external site is not an endorsement of that site's privacy policy. == Information Collected == The that is provided automatically by a browser is recorded in server logs and may be used for traffic analysis. This information includes: === User-Agent === Software programs that allow users to access documents on the World Wide Web are known as User-Agents. Typically these will be &quot;browsers&quot;, such as Mozilla Firefox or Microsoft Internet Explorer. Most User-Agents provide information about the type and version of both the user agent software and the operating system of the computer on which it runs. This information is provided automatically to every web-site the user visits. === IP Address === This is a unique numeric address assigned to each computer connected to the Internet and is provided automatically to every web-site the user visits. Usually, IP Addresses can be resolved to domain names, which may identify an Internet Service Provider (ISP), employer, university, etc. === Referrer === The referrer is the URL (address) of the page from which a request originated and is provided automatically by the User Agent (browser). 2fc4c84e7515fa5be4b6c8159aae6085371f9274 85 82 2014-10-17T20:16:15Z John 2 /* Information Collected */ wikitext text/x-wiki == Statement == The following statement explains how your information will be treated as you make use of my web-site - binding-time.co.uk. It applies to all the public areas of the binding-time.co.uk web-site. binding-time.co.uk does not collect or store any information to identify you individually. The Mediawiki software used by binding-time.co.uk employs cookies for session management. No other cookies are used by binding-time.co.uk. I am not responsible for the privacy practices of external web-sites. A link from binding-time.co.uk to an external site is not an endorsement of that site's privacy policy. == Information Collected == The data that is provided automatically by a browser is recorded in server logs and may be used for traffic analysis. This information includes: === User-Agent === Software programs that allow users to access documents on the World Wide Web are known as User-Agents. Typically these will be &quot;browsers&quot;, such as Mozilla Firefox or Microsoft Internet Explorer. Most User-Agents provide information about the type and version of both the user agent software and the operating system of the computer on which it runs. This information is provided automatically to every web-site the user visits. === IP Address === This is a unique numeric address assigned to each computer connected to the Internet and is provided automatically to every web-site the user visits. Usually, IP Addresses can be resolved to domain names, which may identify an Internet Service Provider (ISP), employer, university, etc. === Referrer === The referrer is the URL (address) of the page from which a request originated and is provided automatically by the User Agent (browser). 3f9ba121e112d9b3c4da72d8da271d2a56d80e08 0 8 97 46 2015-04-30T20:44:23Z John 2 /* water_jugs */ wikitext text/x-wiki __NOTOC__ This classic AI problem is described in ''Artificial Intelligence'' as follows: <blockquote> "You are given two jugs, a 4-gallon one and a 3-gallon one. Neither has any measuring markers on it. There is a tap that can be used to fill the jugs with water. How can you get exactly 2 gallons of water into the 4-gallon jug?". <cite>[http://www.amazon.co.uk/exec/obidos/ASIN/0070522634/bindingtimeli-21 E. Rich & K. Knight, Artificial Intelligence, 2nd edition, McGraw-Hill, 1991]</cite> </blockquote> This program implements an "environmentally responsible" solution to the ''water jugs'' problem. Rather than filling and spilling from an infinite water resource, we conserve a finite initial charge with a third jug: (reservoir). This approach is simpler than the traditional method, because there are only two actions; it is more flexible than the traditional method, because it can solve problems that are constrained by a limited supply from the reservoir. To simulate the infinite version, we use a filled reservoir with a capacity greater than the combined capacities of the jugs, so that the reservoir can never be emptied. <blockquote> "Perfection is achieved not when there is nothing more to add, but when there is nothing more to take away." <cite>[http://en.wikiquote.org/wiki/Antoine_de_Saint-Exupery Antoine de Saint-Exup&#233;ry]</cite> </blockquote> ==Solution== ====water_jugs==== is the entry point. The solution is derived by a simple, breadth-first, state-space search; and translated into a readable format by a DCG. <syntaxhighlight lang="prolog">water_jugs :- SmallCapacity = 3, LargeCapacity = 4, Reservoir is SmallCapacity + LargeCapacity + 1, volume( small, Capacities, SmallCapacity ), volume( large, Capacities, LargeCapacity ), volume( reservoir, Capacities, Reservoir ), volume( small, Start, 0 ), volume( large, Start, 0 ), volume( reservoir, Start, Reservoir ), volume( large, End, 2 ), water_jugs_solution( Start, Capacities, End, Solution ), phrase( narrative(Solution, Capacities, End), Chars ), put_chars( Chars ).</syntaxhighlight> ====water_jugs_solution( +Start, +Capacities, +End, ?Solution )==== holds when <var>Solution</var> is the terminal 'node' in a state-space search - beginning with a 'start state' in which the water-jugs have <var>Capacities</var> and contain the <var>Start</var> volumes. The terminal node is reached when the water-jugs contain the <var>End</var> volumes. <syntaxhighlight lang="prolog"> water_jugs_solution( Start, Capacities, End, Solution ) :- solve_jugs( [start(Start)], Capacities, [], End, Solution ). </syntaxhighlight> ====solve_jugs( +Nodes, +Capacities, +Visited, +End, ?Solution )==== holds when <var>Solution</var> is the terminal 'node' in a state-space search, beginning with a first 'open' node in <var>Nodes</var>, and terminating when the water-jugs contain the <var>End</var> volumes. <var>Capacities</var> define the capacities of the water-jugs, while <var>Visited</var> is a list of expanded ('closed') node states. The 'breadth-first' operation of solve_jugs is due to the 'existing' <var>Nodes</var> being appended to the 'new' nodes. (If the 'new' nodes were appended to the 'existing' nodes, the operation would be 'depth-first'.) <syntaxhighlight lang="prolog"> solve_jugs( [Node|Nodes], Capacities, Visited, End, Solution ) :- node_state( Node, State ), ( State = End -> Solution = Node ; otherwise -> findall( Successor, successor(Node, Capacities, Visited, Successor), Successors ), append( Nodes, Successors, NewNodes ), solve_jugs( NewNodes, Capacities, [State|Visited], End, Solution ) ). </syntaxhighlight> ====successor( +Node, +Capacities, +Visited, ?Successor )==== <var>Successor</var> is a successor of <var>Node</var>, for water-jugs with <var>Capacities</var>, if there is a legal 'transition' from <var>Node</var>'s state to <var>Successor</var>'s state, and <var>Successor</var>'s state is not a member of the <var>Visited</var> states. <syntaxhighlight lang="prolog"> successor( Node, Capacities, Visited, Successor ) :- node_state( Node, State ), Successor = node(Action,State1,Node), jug_transition( State, Capacities, Action, State1 ), \+ member( State1, Visited ). </syntaxhighlight> ===Transition Rules=== ====jug_transition( +State, +Capacities, ?Action, ?SuccessorState )==== holds when <var>Action</var> describes a valid transition, from <var>State</var> to <var>SuccessorState</var>, for water-jugs with <var>Capacities</var>. There are two sorts of <var>Action</var>: * <code>empty_into(Source,Target)</code> valid if ''Source'' is not already empty and the combined contents from ''Source'' and ''Target'', (in <var>State</var>), are not greater than the capacity of the ''Target'' jug. In <var>SuccessorState</var>: ''Source'' becomes empty, while the ''Target'' jug acquires the combined contents of ''Source'' and ''Target'' in <var>State</var>. * <code>fill_from(Source,Target)</code> valid if ''Source'' is not already empty and the combined contents from ''Source'' and ''Target'', (in <var>State</var>), are greater than the capacity of the ''Target'' jug. In <var>SuccessorState</var>: the ''Target'' jug becomes full, while ''Source'' retains the difference between the combined contents of ''Source'' and ''Target'', in <var>State</var>, and the capacity of the ''Target'' jug. In either case, the contents of the unused jug are unchanged. <syntaxhighlight lang="prolog">jug_transition( State0, Capacities, empty_into(Source,Target), State1 ) :- volume( Source, State0, Content0 ), Content0 > 0, jug_permutation( Source, Target, Unused ), volume( Target, State0, Content1 ), volume( Target, Capacities, Capacity ), Content0 + Content1 =< Capacity, volume( Source, State1, 0 ), volume( Target, State1, Content2 ), Content2 is Content0 + Content1, volume( Unused, State0, Unchanged ), volume( Unused, State1, Unchanged ). jug_transition( State0, Capacities, fill_from(Source,Target), State1 ) :- volume( Source, State0, Content0 ), Content0 > 0, jug_permutation( Source, Target, Unused ), volume( Target, State0, Content1 ), volume( Target, Capacities, Capacity ), Content1 < Capacity, Content0 + Content1 > Capacity, volume( Source, State1, Content2 ), volume( Target, State1, Capacity ), Content2 is Content0 + Content1 - Capacity, volume( Unused, State0, Unchanged ), volume( Unused, State1, Unchanged ).</syntaxhighlight> ==Data Abstraction== ====volume( ?Jug, ?State, ?Volume )==== holds when <var>Jug</var> ('large', 'small' or 'reservoir') has <var>Volume</var> in <var>State</var>. <syntaxhighlight lang="prolog"> volume( small, jugs(Small, _Large, _Reservoir), Small ). volume( large, jugs(_Small, Large, _Reservoir), Large ). volume( reservoir, jugs(_Small, _Large, Reservoir), Reservoir ). </syntaxhighlight> ====jug_permutation( ?Source, ?Target, ?Unused )==== holds when <var>Source</var>, <var>Target</var> and <var>Unused</var> are a permutation of 'small', 'large' and 'reservoir'. <syntaxhighlight lang="prolog"> jug_permutation( Source, Target, Unused ) :- select( Source, [small, large, reservoir], Residue ), select( Target, Residue, [Unused] ). </syntaxhighlight> ====node_state( ?Node, ?State )==== holds when the contents of the water-jugs at <var>Node</var> are described by <var>State</var>. <syntaxhighlight lang="prolog"> node_state( start(State), State ). node_state( node(_Transition, State, _Predecessor), State ). </syntaxhighlight> ==Definite Clause Grammar== ====narrative//3==== is a DCG presenting water-jugs solutions in a readable format. The grammar is head-recursive, because the 'nodes list' describing the solution has the last node outermost. <syntaxhighlight lang="prolog"> narrative( start(Start), Capacities, End ) --> "Given three jugs with capacities of:", newline, literal_volumes( Capacities ), "To obtain the result:", newline, literal_volumes( End ), "Starting with:", newline, literal_volumes( Start ), "Do the following:", newline. narrative( node(Transition, Result, Predecessor), Capacities, End ) --> narrative( Predecessor, Capacities, End ), literal_action( Transition, Result ). literal_volumes( Volumes ) --> indent, literal( Volumes ), ";", newline. literal_action( Transition, Result ) --> indent, "- ", literal( Transition ), " giving:", newline, indent, indent, literal( Result ), newline. literal( empty_into(From,To) ) --> "Empty the ", literal( From ), " into the ", literal( To ). literal( fill_from(From,To) ) --> "Fill the ", literal( To ), " from the ", literal( From ). literal( jugs(Small,Large,Reservoir) ) --> literal_number( Small ), " gallons in the small jug, ", literal_number( Large ), " gallons in the large jug and ", literal_number( Reservoir ), " gallons in the reservoir". literal( small ) --> "small jug". literal( large ) --> "large jug". literal( reservoir ) --> "reservoir". literal_number( Number, Plus, Minus ) :- number( Number ), number_chars( Number, Chars ), append( Chars, Minus, Plus ). indent --> " ". newline --> " ". </syntaxhighlight> ==Utility Predicates== Load a small library of [[Puzzle Utilities]]. <syntaxhighlight lang="prolog"> :- ensure_loaded( misc ). </syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/download/water_jugs.txt here]. ==Output== The output of the program is: <div class="result"> <pre> ?- water_jugs. Given three jugs with capacities of: 3 gallons in the small jug, 4 gallons in the large jug and 8 gallons in the reservoir; To obtain the result: 0 gallons in the small jug, 2 gallons in the large jug and 6 gallons in the reservoir; Starting with: 0 gallons in the small jug, 0 gallons in the large jug and 8 gallons in the reservoir; Do the following: - Fill the small jug from the reservoir giving: 3 gallons in the small jug, 0 gallons in the large jug and 5 gallons in the reservoir - Empty the small jug into the large jug giving: 0 gallons in the small jug, 3 gallons in the large jug and 5 gallons in the reservoir - Fill the small jug from the reservoir giving: 3 gallons in the small jug, 3 gallons in the large jug and 2 gallons in the reservoir - Fill the large jug from the small jug giving: 2 gallons in the small jug, 4 gallons in the large jug and 2 gallons in the reservoir - Empty the large jug into the reservoir giving: 2 gallons in the small jug, 0 gallons in the large jug and 6 gallons in the reservoir - Empty the small jug into the large jug giving: 0 gallons in the small jug, 2 gallons in the large jug and 6 gallons in the reservoir yes </pre> </div> b6760f781ce9f705f45d62e93dcdf19eff630694 98 97 2015-04-30T20:52:07Z John 2 Tidy up formatting. wikitext text/x-wiki __NOTOC__ This classic AI problem is described in ''Artificial Intelligence'' as follows: <blockquote> "You are given two jugs, a 4-gallon one and a 3-gallon one. Neither has any measuring markers on it. There is a tap that can be used to fill the jugs with water. How can you get exactly 2 gallons of water into the 4-gallon jug?". <cite>[http://www.amazon.co.uk/exec/obidos/ASIN/0070522634/bindingtimeli-21 E. Rich & K. Knight, Artificial Intelligence, 2nd edition, McGraw-Hill, 1991]</cite> </blockquote> This program implements an "environmentally responsible" solution to the ''water jugs'' problem. Rather than filling and spilling from an infinite water resource, we conserve a finite initial charge with a third jug: (reservoir). This approach is simpler than the traditional method, because there are only two actions; it is more flexible than the traditional method, because it can solve problems that are constrained by a limited supply from the reservoir. To simulate the infinite version, we use a filled reservoir with a capacity greater than the combined capacities of the jugs, so that the reservoir can never be emptied. <blockquote> "Perfection is achieved not when there is nothing more to add, but when there is nothing more to take away." <cite>[http://en.wikiquote.org/wiki/Antoine_de_Saint-Exupery Antoine de Saint-Exup&#233;ry]</cite> </blockquote> ==Solution== ====water_jugs==== is the entry point. The solution is derived by a simple, breadth-first, state-space search; and translated into a readable format by a DCG. <syntaxhighlight lang="prolog">water_jugs :- SmallCapacity = 3, LargeCapacity = 4, Reservoir is SmallCapacity + LargeCapacity + 1, volume( small, Capacities, SmallCapacity ), volume( large, Capacities, LargeCapacity ), volume( reservoir, Capacities, Reservoir ), volume( small, Start, 0 ), volume( large, Start, 0 ), volume( reservoir, Start, Reservoir ), volume( large, End, 2 ), water_jugs_solution( Start, Capacities, End, Solution ), phrase( narrative(Solution, Capacities, End), Chars ), put_chars( Chars ).</syntaxhighlight> ====water_jugs_solution( +Start, +Capacities, +End, ?Solution )==== holds when <var>Solution</var> is the terminal 'node' in a state-space search - beginning with a 'start state' in which the water-jugs have <var>Capacities</var> and contain the <var>Start</var> volumes. The terminal node is reached when the water-jugs contain the <var>End</var> volumes. <syntaxhighlight lang="prolog"> water_jugs_solution( Start, Capacities, End, Solution ) :- solve_jugs( [start(Start)], Capacities, [], End, Solution ). </syntaxhighlight> ====solve_jugs( +Nodes, +Capacities, +Visited, +End, ?Solution )==== holds when <var>Solution</var> is the terminal 'node' in a state-space search, beginning with a first 'open' node in <var>Nodes</var>, and terminating when the water-jugs contain the <var>End</var> volumes. <var>Capacities</var> define the capacities of the water-jugs, while <var>Visited</var> is a list of expanded ('closed') node states. The 'breadth-first' operation of solve_jugs is due to the 'existing' <var>Nodes</var> being appended to the 'new' nodes. (If the 'new' nodes were appended to the 'existing' nodes, the operation would be 'depth-first'.) <syntaxhighlight lang="prolog"> solve_jugs( [Node|Nodes], Capacities, Visited, End, Solution ) :- node_state( Node, State ), ( State = End -> Solution = Node ; otherwise -> findall( Successor, successor(Node, Capacities, Visited, Successor), Successors ), append( Nodes, Successors, NewNodes ), solve_jugs( NewNodes, Capacities, [State|Visited], End, Solution ) ). </syntaxhighlight> ====successor( +Node, +Capacities, +Visited, ?Successor )==== <var>Successor</var> is a successor of <var>Node</var>, for water-jugs with <var>Capacities</var>, if there is a legal 'transition' from <var>Node</var>'s state to <var>Successor</var>'s state, and <var>Successor</var>'s state is not a member of the <var>Visited</var> states. <syntaxhighlight lang="prolog"> successor( Node, Capacities, Visited, Successor ) :- node_state( Node, State ), Successor = node(Action,State1,Node), jug_transition( State, Capacities, Action, State1 ), \+ member( State1, Visited ). </syntaxhighlight> ===Transition Rules=== ====jug_transition( +State, +Capacities, ?Action, ?SuccessorState )==== holds when <var>Action</var> describes a valid transition, from <var>State</var> to <var>SuccessorState</var>, for water-jugs with <var>Capacities</var>. There are two sorts of <var>Action</var>: * <code>empty_into(Source,Target)</code> valid if ''Source'' is not already empty and the combined contents from ''Source'' and ''Target'', (in <var>State</var>), are not greater than the capacity of the ''Target'' jug. In <var>SuccessorState</var>: ''Source'' becomes empty, while the ''Target'' jug acquires the combined contents of ''Source'' and ''Target'' in <var>State</var>. * <code>fill_from(Source,Target)</code> valid if ''Source'' is not already empty and the combined contents from ''Source'' and ''Target'', (in <var>State</var>), are greater than the capacity of the ''Target'' jug. In <var>SuccessorState</var>: the ''Target'' jug becomes full, while ''Source'' retains the difference between the combined contents of ''Source'' and ''Target'', in <var>State</var>, and the capacity of the ''Target'' jug. In either case, the contents of the unused jug are unchanged. <syntaxhighlight lang="prolog">jug_transition( State0, Capacities, empty_into(Source,Target), State1 ) :- volume( Source, State0, Content0 ), Content0 > 0, jug_permutation( Source, Target, Unused ), volume( Target, State0, Content1 ), volume( Target, Capacities, Capacity ), Content0 + Content1 =< Capacity, volume( Source, State1, 0 ), volume( Target, State1, Content2 ), Content2 is Content0 + Content1, volume( Unused, State0, Unchanged ), volume( Unused, State1, Unchanged ). jug_transition( State0, Capacities, fill_from(Source,Target), State1 ) :- volume( Source, State0, Content0 ), Content0 > 0, jug_permutation( Source, Target, Unused ), volume( Target, State0, Content1 ), volume( Target, Capacities, Capacity ), Content1 < Capacity, Content0 + Content1 > Capacity, volume( Source, State1, Content2 ), volume( Target, State1, Capacity ), Content2 is Content0 + Content1 - Capacity, volume( Unused, State0, Unchanged ), volume( Unused, State1, Unchanged ).</syntaxhighlight> ==Data Abstraction== ====volume( ?Jug, ?State, ?Volume )==== holds when <var>Jug</var> ('large', 'small' or 'reservoir') has <var>Volume</var> in <var>State</var>. <syntaxhighlight lang="prolog"> volume( small, jugs(Small, _Large, _Reservoir), Small ). volume( large, jugs(_Small, Large, _Reservoir), Large ). volume( reservoir, jugs(_Small, _Large, Reservoir), Reservoir ). </syntaxhighlight> ====jug_permutation( ?Source, ?Target, ?Unused )==== holds when <var>Source</var>, <var>Target</var> and <var>Unused</var> are a permutation of 'small', 'large' and 'reservoir'. <syntaxhighlight lang="prolog"> jug_permutation( Source, Target, Unused ) :- select( Source, [small, large, reservoir], Residue ), select( Target, Residue, [Unused] ). </syntaxhighlight> ====node_state( ?Node, ?State )==== holds when the contents of the water-jugs at <var>Node</var> are described by <var>State</var>. <syntaxhighlight lang="prolog"> node_state( start(State), State ). node_state( node(_Transition, State, _Predecessor), State ). </syntaxhighlight> ==Definite Clause Grammar== ====narrative( +Solution, +Capacities, +End )/==== is a DCG presenting the water-jugs <var>Solution</var> in a readable format. The grammar is head-recursive, because the <var>Solution</var> has the last node outermost. <syntaxhighlight lang="prolog"> narrative( start(Start), Capacities, End ) --> "Given three jugs with capacities of:", newline, literal_volumes( Capacities ), "To obtain the result:", newline, literal_volumes( End ), "Starting with:", newline, literal_volumes( Start ), "Do the following:", newline. narrative( node(Transition, Result, Predecessor), Capacities, End ) --> narrative( Predecessor, Capacities, End ), literal_action( Transition, Result ). literal_volumes( Volumes ) --> indent, literal( Volumes ), ";", newline. literal_action( Transition, Result ) --> indent, "- ", literal( Transition ), " giving:", newline, indent, indent, literal( Result ), newline. literal( empty_into(From,To) ) --> "Empty the ", literal( From ), " into the ", literal( To ). literal( fill_from(From,To) ) --> "Fill the ", literal( To ), " from the ", literal( From ). literal( jugs(Small,Large,Reservoir) ) --> literal_number( Small ), " gallons in the small jug, ", literal_number( Large ), " gallons in the large jug and ", literal_number( Reservoir ), " gallons in the reservoir". literal( small ) --> "small jug". literal( large ) --> "large jug". literal( reservoir ) --> "reservoir". literal_number( Number, Plus, Minus ) :- number( Number ), number_chars( Number, Chars ), append( Chars, Minus, Plus ). indent --> " ". newline --> " ". </syntaxhighlight> ==Utility Predicates== Load a small library of [[Puzzle Utilities]]. <syntaxhighlight lang="prolog"> :- ensure_loaded( misc ). </syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/download/water_jugs.txt here]. ==Output== The output of the program is: <div class="result"> <pre> ?- water_jugs. Given three jugs with capacities of: 3 gallons in the small jug, 4 gallons in the large jug and 8 gallons in the reservoir; To obtain the result: 0 gallons in the small jug, 2 gallons in the large jug and 6 gallons in the reservoir; Starting with: 0 gallons in the small jug, 0 gallons in the large jug and 8 gallons in the reservoir; Do the following: - Fill the small jug from the reservoir giving: 3 gallons in the small jug, 0 gallons in the large jug and 5 gallons in the reservoir - Empty the small jug into the large jug giving: 0 gallons in the small jug, 3 gallons in the large jug and 5 gallons in the reservoir - Fill the small jug from the reservoir giving: 3 gallons in the small jug, 3 gallons in the large jug and 2 gallons in the reservoir - Fill the large jug from the small jug giving: 2 gallons in the small jug, 4 gallons in the large jug and 2 gallons in the reservoir - Empty the large jug into the reservoir giving: 2 gallons in the small jug, 0 gallons in the large jug and 6 gallons in the reservoir - Empty the small jug into the large jug giving: 0 gallons in the small jug, 2 gallons in the large jug and 6 gallons in the reservoir yes </pre> </div> 8990e8a862129f257c04623e540f8eaa552b4c20 0 8 102 98 2015-05-12T10:50:19Z John 2 wikitext text/x-wiki __NOTOC__ This classic AI problem is described in ''Artificial Intelligence'' as follows: <blockquote> &ldquo;You are given two jugs, a 4-gallon one and a 3-gallon one. Neither has any measuring markers on it. There is a tap that can be used to fill the jugs with water. How can you get exactly 2 gallons of water into the 4-gallon jug?&rdquo;. <cite>[http://www.amazon.co.uk/exec/obidos/ASIN/0070522634/bindingtimeli-21 E. Rich & K. Knight, Artificial Intelligence, 2nd edition, McGraw-Hill, 1991]</cite> </blockquote> This program implements an &ldquo;environmentally responsible&rdquo; solution to the ''water jugs'' problem. Rather than filling and spilling from an infinite water resource, we conserve a finite initial charge with a third jug: (reservoir). This approach is simpler than the traditional method, because there are only two actions; it is more flexible than the traditional method, because it can solve problems that are constrained by a limited supply from the reservoir. To simulate the infinite version, we use a filled reservoir with a capacity greater than the combined capacities of the jugs, so that the reservoir can never be emptied. <blockquote> &ldquo;Perfection is achieved not when there is nothing more to add, but when there is nothing more to take away.&rdquo; <cite>[http://en.wikiquote.org/wiki/Antoine_de_Saint-Exupery Antoine de Saint-Exup&#233;ry]</cite> </blockquote> ==Solution== ====water_jugs==== is the entry point. The solution is derived by a simple, breadth-first, state-space search; and translated into a readable format by a DCG. <syntaxhighlight lang="prolog">water_jugs :- SmallCapacity = 3, LargeCapacity = 4, Reservoir is SmallCapacity + LargeCapacity + 1, volume( small, Capacities, SmallCapacity ), volume( large, Capacities, LargeCapacity ), volume( reservoir, Capacities, Reservoir ), volume( small, Start, 0 ), volume( large, Start, 0 ), volume( reservoir, Start, Reservoir ), volume( large, End, 2 ), water_jugs_solution( Start, Capacities, End, Solution ), phrase( narrative(Solution, Capacities, End), Chars ), put_chars( Chars ).</syntaxhighlight> ====water_jugs_solution( +Start, +Capacities, +End, ?Solution )==== holds when <var>Solution</var> is the terminal &lsquo;node&rsquo; in a state-space search - beginning with a &lsquo;start state&rsquo; in which the water-jugs have <var>Capacities</var> and contain the <var>Start</var> volumes. The terminal node is reached when the water-jugs contain the <var>End</var> volumes. <syntaxhighlight lang="prolog"> water_jugs_solution( Start, Capacities, End, Solution ) :- solve_jugs( [start(Start)], Capacities, [], End, Solution ). </syntaxhighlight> ====solve_jugs( +Nodes, +Capacities, +Visited, +End, ?Solution )==== holds when <var>Solution</var> is the terminal node in a state-space search, beginning with a first open node in <var>Nodes</var>, and terminating when the water-jugs contain the <var>End</var> volumes. <var>Capacities</var> define the capacities of the water-jugs, while <var>Visited</var> is a list of expanded (closed) node states. The breadth-first operation of solve_jugs is due to the existing <var>Nodes</var> being appended to the new nodes. (If the new nodes were appended to the existing nodes, the operation would be depth-first.) <syntaxhighlight lang="prolog"> solve_jugs( [Node|Nodes], Capacities, Visited, End, Solution ) :- node_state( Node, State ), ( State = End -> Solution = Node ; otherwise -> findall( Successor, successor(Node, Capacities, Visited, Successor), Successors ), append( Nodes, Successors, NewNodes ), solve_jugs( NewNodes, Capacities, [State|Visited], End, Solution ) ). </syntaxhighlight> ====successor( +Node, +Capacities, +Visited, ?Successor )==== <var>Successor</var> is a successor of <var>Node</var>, for water-jugs with <var>Capacities</var>, if there is a legal transition from <var>Node</var>'s state to <var>Successor</var>'s state, and <var>Successor</var>'s state is not a member of the <var>Visited</var> states. <syntaxhighlight lang="prolog"> successor( Node, Capacities, Visited, Successor ) :- node_state( Node, State ), Successor = node(Action,State1,Node), jug_transition( State, Capacities, Action, State1 ), \+ member( State1, Visited ). </syntaxhighlight> ===Transition Rules=== ====jug_transition( +State, +Capacities, ?Action, ?SuccessorState )==== holds when <var>Action</var> describes a valid transition, from <var>State</var> to <var>SuccessorState</var>, for water-jugs with <var>Capacities</var>. There are two sorts of <var>Action</var>: * <code>empty_into(Source,Target)</code> valid if ''Source'' is not already empty and the combined contents from ''Source'' and ''Target'', (in <var>State</var>), are not greater than the capacity of the ''Target'' jug. In <var>SuccessorState</var>: ''Source'' becomes empty, while the ''Target'' jug acquires the combined contents of ''Source'' and ''Target'' in <var>State</var>. * <code>fill_from(Source,Target)</code> valid if ''Source'' is not already empty and the combined contents from ''Source'' and ''Target'', (in <var>State</var>), are greater than the capacity of the ''Target'' jug. In <var>SuccessorState</var>: the ''Target'' jug becomes full, while ''Source'' retains the difference between the combined contents of ''Source'' and ''Target'', in <var>State</var>, and the capacity of the ''Target'' jug. In either case, the contents of the unused jug are unchanged. <syntaxhighlight lang="prolog">jug_transition( State0, Capacities, empty_into(Source,Target), State1 ) :- volume( Source, State0, Content0 ), Content0 > 0, jug_permutation( Source, Target, Unused ), volume( Target, State0, Content1 ), volume( Target, Capacities, Capacity ), Content0 + Content1 =< Capacity, volume( Source, State1, 0 ), volume( Target, State1, Content2 ), Content2 is Content0 + Content1, volume( Unused, State0, Unchanged ), volume( Unused, State1, Unchanged ). jug_transition( State0, Capacities, fill_from(Source,Target), State1 ) :- volume( Source, State0, Content0 ), Content0 > 0, jug_permutation( Source, Target, Unused ), volume( Target, State0, Content1 ), volume( Target, Capacities, Capacity ), Content1 < Capacity, Content0 + Content1 > Capacity, volume( Source, State1, Content2 ), volume( Target, State1, Capacity ), Content2 is Content0 + Content1 - Capacity, volume( Unused, State0, Unchanged ), volume( Unused, State1, Unchanged ).</syntaxhighlight> ==Data Abstraction== ====volume( ?Jug, ?State, ?Volume )==== holds when <var>Jug</var> (large, small or reservoir) has <var>Volume</var> in <var>State</var>. <syntaxhighlight lang="prolog"> volume( small, jugs(Small, _Large, _Reservoir), Small ). volume( large, jugs(_Small, Large, _Reservoir), Large ). volume( reservoir, jugs(_Small, _Large, Reservoir), Reservoir ). </syntaxhighlight> ====jug_permutation( ?Source, ?Target, ?Unused )==== holds when <var>Source</var>, <var>Target</var> and <var>Unused</var> are a permutation of <code>small</code>, <code>large</code> and <code>reservoir</code>. <syntaxhighlight lang="prolog"> jug_permutation( Source, Target, Unused ) :- select( Source, [small, large, reservoir], Residue ), select( Target, Residue, [Unused] ). </syntaxhighlight> ====node_state( ?Node, ?State )==== holds when the contents of the water-jugs at <var>Node</var> are described by <var>State</var>. <syntaxhighlight lang="prolog"> node_state( start(State), State ). node_state( node(_Transition, State, _Predecessor), State ). </syntaxhighlight> ==Definite Clause Grammar== ====narrative( +Solution, +Capacities, +End )/==== is a DCG presenting the water-jugs <var>Solution</var> in a readable format. The grammar is head-recursive, because the <var>Solution</var> has the last node outermost. <syntaxhighlight lang="prolog"> narrative( start(Start), Capacities, End ) --> "Given three jugs with capacities of:", newline, literal_volumes( Capacities ), "To obtain the result:", newline, literal_volumes( End ), "Starting with:", newline, literal_volumes( Start ), "Do the following:", newline. narrative( node(Transition, Result, Predecessor), Capacities, End ) --> narrative( Predecessor, Capacities, End ), literal_action( Transition, Result ). literal_volumes( Volumes ) --> indent, literal( Volumes ), ";", newline. literal_action( Transition, Result ) --> indent, "- ", literal( Transition ), " giving:", newline, indent, indent, literal( Result ), newline. literal( empty_into(From,To) ) --> "Empty the ", literal( From ), " into the ", literal( To ). literal( fill_from(From,To) ) --> "Fill the ", literal( To ), " from the ", literal( From ). literal( jugs(Small,Large,Reservoir) ) --> literal_number( Small ), " gallons in the small jug, ", literal_number( Large ), " gallons in the large jug and ", literal_number( Reservoir ), " gallons in the reservoir". literal( small ) --> "small jug". literal( large ) --> "large jug". literal( reservoir ) --> "reservoir". literal_number( Number, Plus, Minus ) :- number( Number ), number_chars( Number, Chars ), append( Chars, Minus, Plus ). indent --> " ". newline --> " ". </syntaxhighlight> ==Utility Predicates== Load a small library of [[Puzzle Utilities]]. <syntaxhighlight lang="prolog"> :- ensure_loaded( misc ). </syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/download/water_jugs.txt here]. ==Output== The output of the program is: <div class="result"> <pre> ?- water_jugs. Given three jugs with capacities of: 3 gallons in the small jug, 4 gallons in the large jug and 8 gallons in the reservoir; To obtain the result: 0 gallons in the small jug, 2 gallons in the large jug and 6 gallons in the reservoir; Starting with: 0 gallons in the small jug, 0 gallons in the large jug and 8 gallons in the reservoir; Do the following: - Fill the small jug from the reservoir giving: 3 gallons in the small jug, 0 gallons in the large jug and 5 gallons in the reservoir - Empty the small jug into the large jug giving: 0 gallons in the small jug, 3 gallons in the large jug and 5 gallons in the reservoir - Fill the small jug from the reservoir giving: 3 gallons in the small jug, 3 gallons in the large jug and 2 gallons in the reservoir - Fill the large jug from the small jug giving: 2 gallons in the small jug, 4 gallons in the large jug and 2 gallons in the reservoir - Empty the large jug into the reservoir giving: 2 gallons in the small jug, 0 gallons in the large jug and 6 gallons in the reservoir - Empty the small jug into the large jug giving: 0 gallons in the small jug, 2 gallons in the large jug and 6 gallons in the reservoir yes </pre> </div> 4f1b27ecd3698058e6e93c1f7c6456aaee6ab9ae 103 102 2015-05-12T13:06:57Z John 2 /* jug_transition( +State, +Capacities, ?Action, ?SuccessorState ) */ wikitext text/x-wiki __NOTOC__ This classic AI problem is described in ''Artificial Intelligence'' as follows: <blockquote> &ldquo;You are given two jugs, a 4-gallon one and a 3-gallon one. Neither has any measuring markers on it. There is a tap that can be used to fill the jugs with water. How can you get exactly 2 gallons of water into the 4-gallon jug?&rdquo;. <cite>[http://www.amazon.co.uk/exec/obidos/ASIN/0070522634/bindingtimeli-21 E. Rich & K. Knight, Artificial Intelligence, 2nd edition, McGraw-Hill, 1991]</cite> </blockquote> This program implements an &ldquo;environmentally responsible&rdquo; solution to the ''water jugs'' problem. Rather than filling and spilling from an infinite water resource, we conserve a finite initial charge with a third jug: (reservoir). This approach is simpler than the traditional method, because there are only two actions; it is more flexible than the traditional method, because it can solve problems that are constrained by a limited supply from the reservoir. To simulate the infinite version, we use a filled reservoir with a capacity greater than the combined capacities of the jugs, so that the reservoir can never be emptied. <blockquote> &ldquo;Perfection is achieved not when there is nothing more to add, but when there is nothing more to take away.&rdquo; <cite>[http://en.wikiquote.org/wiki/Antoine_de_Saint-Exupery Antoine de Saint-Exup&#233;ry]</cite> </blockquote> ==Solution== ====water_jugs==== is the entry point. The solution is derived by a simple, breadth-first, state-space search; and translated into a readable format by a DCG. <syntaxhighlight lang="prolog">water_jugs :- SmallCapacity = 3, LargeCapacity = 4, Reservoir is SmallCapacity + LargeCapacity + 1, volume( small, Capacities, SmallCapacity ), volume( large, Capacities, LargeCapacity ), volume( reservoir, Capacities, Reservoir ), volume( small, Start, 0 ), volume( large, Start, 0 ), volume( reservoir, Start, Reservoir ), volume( large, End, 2 ), water_jugs_solution( Start, Capacities, End, Solution ), phrase( narrative(Solution, Capacities, End), Chars ), put_chars( Chars ).</syntaxhighlight> ====water_jugs_solution( +Start, +Capacities, +End, ?Solution )==== holds when <var>Solution</var> is the terminal &lsquo;node&rsquo; in a state-space search - beginning with a &lsquo;start state&rsquo; in which the water-jugs have <var>Capacities</var> and contain the <var>Start</var> volumes. The terminal node is reached when the water-jugs contain the <var>End</var> volumes. <syntaxhighlight lang="prolog"> water_jugs_solution( Start, Capacities, End, Solution ) :- solve_jugs( [start(Start)], Capacities, [], End, Solution ). </syntaxhighlight> ====solve_jugs( +Nodes, +Capacities, +Visited, +End, ?Solution )==== holds when <var>Solution</var> is the terminal node in a state-space search, beginning with a first open node in <var>Nodes</var>, and terminating when the water-jugs contain the <var>End</var> volumes. <var>Capacities</var> define the capacities of the water-jugs, while <var>Visited</var> is a list of expanded (closed) node states. The breadth-first operation of solve_jugs is due to the existing <var>Nodes</var> being appended to the new nodes. (If the new nodes were appended to the existing nodes, the operation would be depth-first.) <syntaxhighlight lang="prolog"> solve_jugs( [Node|Nodes], Capacities, Visited, End, Solution ) :- node_state( Node, State ), ( State = End -> Solution = Node ; otherwise -> findall( Successor, successor(Node, Capacities, Visited, Successor), Successors ), append( Nodes, Successors, NewNodes ), solve_jugs( NewNodes, Capacities, [State|Visited], End, Solution ) ). </syntaxhighlight> ====successor( +Node, +Capacities, +Visited, ?Successor )==== <var>Successor</var> is a successor of <var>Node</var>, for water-jugs with <var>Capacities</var>, if there is a legal transition from <var>Node</var>'s state to <var>Successor</var>'s state, and <var>Successor</var>'s state is not a member of the <var>Visited</var> states. <syntaxhighlight lang="prolog"> successor( Node, Capacities, Visited, Successor ) :- node_state( Node, State ), Successor = node(Action,State1,Node), jug_transition( State, Capacities, Action, State1 ), \+ member( State1, Visited ). </syntaxhighlight> ===Transition Rules=== ====jug_transition( +State, +Capacities, ?Action, ?SuccessorState )==== holds when <var>Action</var> describes a valid transition, from <var>State</var> to <var>SuccessorState</var>, for water-jugs with <var>Capacities</var>. There are two sorts of <var>Action</var>: * <code>empty_into(Source,Target)</code> valid if ''Source'' is not already empty and the combined contents from ''Source'' and ''Target'', (in <var>State</var>), are not greater than the capacity of the ''Target'' jug. : In <var>SuccessorState</var> &ndash; ''Source'' becomes empty, while the ''Target'' jug acquires the combined contents of ''Source'' and ''Target'' in <var>State</var>. * <code>fill_from(Source,Target)</code> valid if ''Source'' is not already empty, and the combined contents from ''Source'' and ''Target'', (in <var>State</var>), are greater than the capacity of the ''Target'' jug. : In <var>SuccessorState</var> &ndash; the ''Target'' jug becomes full, while ''Source'' retains the excess of the combined contents of ''Source'' and ''Target'', in <var>State</var>, over the capacity of the ''Target'' jug. In either case, the contents of the unused jug are unchanged. <syntaxhighlight lang="prolog">jug_transition( State0, Capacities, empty_into(Source,Target), State1 ) :- volume( Source, State0, Content0 ), Content0 > 0, jug_permutation( Source, Target, Unused ), volume( Target, State0, Content1 ), volume( Target, Capacities, Capacity ), Content0 + Content1 =< Capacity, volume( Source, State1, 0 ), volume( Target, State1, Content2 ), Content2 is Content0 + Content1, volume( Unused, State0, Unchanged ), volume( Unused, State1, Unchanged ). jug_transition( State0, Capacities, fill_from(Source,Target), State1 ) :- volume( Source, State0, Content0 ), Content0 > 0, jug_permutation( Source, Target, Unused ), volume( Target, State0, Content1 ), volume( Target, Capacities, Capacity ), Content1 < Capacity, Content0 + Content1 > Capacity, volume( Source, State1, Content2 ), volume( Target, State1, Capacity ), Content2 is Content0 + Content1 - Capacity, volume( Unused, State0, Unchanged ), volume( Unused, State1, Unchanged ).</syntaxhighlight> ==Data Abstraction== ====volume( ?Jug, ?State, ?Volume )==== holds when <var>Jug</var> (large, small or reservoir) has <var>Volume</var> in <var>State</var>. <syntaxhighlight lang="prolog"> volume( small, jugs(Small, _Large, _Reservoir), Small ). volume( large, jugs(_Small, Large, _Reservoir), Large ). volume( reservoir, jugs(_Small, _Large, Reservoir), Reservoir ). </syntaxhighlight> ====jug_permutation( ?Source, ?Target, ?Unused )==== holds when <var>Source</var>, <var>Target</var> and <var>Unused</var> are a permutation of <code>small</code>, <code>large</code> and <code>reservoir</code>. <syntaxhighlight lang="prolog"> jug_permutation( Source, Target, Unused ) :- select( Source, [small, large, reservoir], Residue ), select( Target, Residue, [Unused] ). </syntaxhighlight> ====node_state( ?Node, ?State )==== holds when the contents of the water-jugs at <var>Node</var> are described by <var>State</var>. <syntaxhighlight lang="prolog"> node_state( start(State), State ). node_state( node(_Transition, State, _Predecessor), State ). </syntaxhighlight> ==Definite Clause Grammar== ====narrative( +Solution, +Capacities, +End )/==== is a DCG presenting the water-jugs <var>Solution</var> in a readable format. The grammar is head-recursive, because the <var>Solution</var> has the last node outermost. <syntaxhighlight lang="prolog"> narrative( start(Start), Capacities, End ) --> "Given three jugs with capacities of:", newline, literal_volumes( Capacities ), "To obtain the result:", newline, literal_volumes( End ), "Starting with:", newline, literal_volumes( Start ), "Do the following:", newline. narrative( node(Transition, Result, Predecessor), Capacities, End ) --> narrative( Predecessor, Capacities, End ), literal_action( Transition, Result ). literal_volumes( Volumes ) --> indent, literal( Volumes ), ";", newline. literal_action( Transition, Result ) --> indent, "- ", literal( Transition ), " giving:", newline, indent, indent, literal( Result ), newline. literal( empty_into(From,To) ) --> "Empty the ", literal( From ), " into the ", literal( To ). literal( fill_from(From,To) ) --> "Fill the ", literal( To ), " from the ", literal( From ). literal( jugs(Small,Large,Reservoir) ) --> literal_number( Small ), " gallons in the small jug, ", literal_number( Large ), " gallons in the large jug and ", literal_number( Reservoir ), " gallons in the reservoir". literal( small ) --> "small jug". literal( large ) --> "large jug". literal( reservoir ) --> "reservoir". literal_number( Number, Plus, Minus ) :- number( Number ), number_chars( Number, Chars ), append( Chars, Minus, Plus ). indent --> " ". newline --> " ". </syntaxhighlight> ==Utility Predicates== Load a small library of [[Puzzle Utilities]]. <syntaxhighlight lang="prolog"> :- ensure_loaded( misc ). </syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/download/water_jugs.txt here]. ==Output== The output of the program is: <div class="result"> <pre> ?- water_jugs. Given three jugs with capacities of: 3 gallons in the small jug, 4 gallons in the large jug and 8 gallons in the reservoir; To obtain the result: 0 gallons in the small jug, 2 gallons in the large jug and 6 gallons in the reservoir; Starting with: 0 gallons in the small jug, 0 gallons in the large jug and 8 gallons in the reservoir; Do the following: - Fill the small jug from the reservoir giving: 3 gallons in the small jug, 0 gallons in the large jug and 5 gallons in the reservoir - Empty the small jug into the large jug giving: 0 gallons in the small jug, 3 gallons in the large jug and 5 gallons in the reservoir - Fill the small jug from the reservoir giving: 3 gallons in the small jug, 3 gallons in the large jug and 2 gallons in the reservoir - Fill the large jug from the small jug giving: 2 gallons in the small jug, 4 gallons in the large jug and 2 gallons in the reservoir - Empty the large jug into the reservoir giving: 2 gallons in the small jug, 0 gallons in the large jug and 6 gallons in the reservoir - Empty the small jug into the large jug giving: 0 gallons in the small jug, 2 gallons in the large jug and 6 gallons in the reservoir yes </pre> </div> 69dcf285f8d8275bd02509d9d23420baa9282394 104 103 2015-05-12T19:56:42Z John 2 /* jug_transition( +State, +Capacities, ?Action, ?SuccessorState ) */ wikitext text/x-wiki __NOTOC__ This classic AI problem is described in ''Artificial Intelligence'' as follows: <blockquote> &ldquo;You are given two jugs, a 4-gallon one and a 3-gallon one. Neither has any measuring markers on it. There is a tap that can be used to fill the jugs with water. How can you get exactly 2 gallons of water into the 4-gallon jug?&rdquo;. <cite>[http://www.amazon.co.uk/exec/obidos/ASIN/0070522634/bindingtimeli-21 E. Rich & K. Knight, Artificial Intelligence, 2nd edition, McGraw-Hill, 1991]</cite> </blockquote> This program implements an &ldquo;environmentally responsible&rdquo; solution to the ''water jugs'' problem. Rather than filling and spilling from an infinite water resource, we conserve a finite initial charge with a third jug: (reservoir). This approach is simpler than the traditional method, because there are only two actions; it is more flexible than the traditional method, because it can solve problems that are constrained by a limited supply from the reservoir. To simulate the infinite version, we use a filled reservoir with a capacity greater than the combined capacities of the jugs, so that the reservoir can never be emptied. <blockquote> &ldquo;Perfection is achieved not when there is nothing more to add, but when there is nothing more to take away.&rdquo; <cite>[http://en.wikiquote.org/wiki/Antoine_de_Saint-Exupery Antoine de Saint-Exup&#233;ry]</cite> </blockquote> ==Solution== ====water_jugs==== is the entry point. The solution is derived by a simple, breadth-first, state-space search; and translated into a readable format by a DCG. <syntaxhighlight lang="prolog">water_jugs :- SmallCapacity = 3, LargeCapacity = 4, Reservoir is SmallCapacity + LargeCapacity + 1, volume( small, Capacities, SmallCapacity ), volume( large, Capacities, LargeCapacity ), volume( reservoir, Capacities, Reservoir ), volume( small, Start, 0 ), volume( large, Start, 0 ), volume( reservoir, Start, Reservoir ), volume( large, End, 2 ), water_jugs_solution( Start, Capacities, End, Solution ), phrase( narrative(Solution, Capacities, End), Chars ), put_chars( Chars ).</syntaxhighlight> ====water_jugs_solution( +Start, +Capacities, +End, ?Solution )==== holds when <var>Solution</var> is the terminal &lsquo;node&rsquo; in a state-space search - beginning with a &lsquo;start state&rsquo; in which the water-jugs have <var>Capacities</var> and contain the <var>Start</var> volumes. The terminal node is reached when the water-jugs contain the <var>End</var> volumes. <syntaxhighlight lang="prolog"> water_jugs_solution( Start, Capacities, End, Solution ) :- solve_jugs( [start(Start)], Capacities, [], End, Solution ). </syntaxhighlight> ====solve_jugs( +Nodes, +Capacities, +Visited, +End, ?Solution )==== holds when <var>Solution</var> is the terminal node in a state-space search, beginning with a first open node in <var>Nodes</var>, and terminating when the water-jugs contain the <var>End</var> volumes. <var>Capacities</var> define the capacities of the water-jugs, while <var>Visited</var> is a list of expanded (closed) node states. The breadth-first operation of solve_jugs is due to the existing <var>Nodes</var> being appended to the new nodes. (If the new nodes were appended to the existing nodes, the operation would be depth-first.) <syntaxhighlight lang="prolog"> solve_jugs( [Node|Nodes], Capacities, Visited, End, Solution ) :- node_state( Node, State ), ( State = End -> Solution = Node ; otherwise -> findall( Successor, successor(Node, Capacities, Visited, Successor), Successors ), append( Nodes, Successors, NewNodes ), solve_jugs( NewNodes, Capacities, [State|Visited], End, Solution ) ). </syntaxhighlight> ====successor( +Node, +Capacities, +Visited, ?Successor )==== <var>Successor</var> is a successor of <var>Node</var>, for water-jugs with <var>Capacities</var>, if there is a legal transition from <var>Node</var>'s state to <var>Successor</var>'s state, and <var>Successor</var>'s state is not a member of the <var>Visited</var> states. <syntaxhighlight lang="prolog"> successor( Node, Capacities, Visited, Successor ) :- node_state( Node, State ), Successor = node(Action,State1,Node), jug_transition( State, Capacities, Action, State1 ), \+ member( State1, Visited ). </syntaxhighlight> ===Transition Rules=== ====jug_transition( +State, +Capacities, ?Action, ?SuccessorState )==== holds when <var>Action</var> describes a valid transition, from <var>State</var> to <var>SuccessorState</var>, for water-jugs with <var>Capacities</var>. There are two sorts of <var>Action</var>: * <code>empty_into(Source,Target)</code> valid if ''Source'' is not already empty and the combined contents from ''Source'' and ''Target'', in <var>State</var>, are not greater than the capacity of the ''Target'' jug. The ''Source'' jug becomes empty in <var>SuccessorState</var>, while the ''Target'' jug acquires the combined contents of ''Source'' and ''Target'' in <var>State</var>. * <code>fill_from(Source,Target)</code> valid if ''Source'' is not already empty, and the combined contents from ''Source'' and ''Target'', in <var>State</var>, are greater than the capacity of the ''Target'' jug. The ''Target'' jug becomes full in <var>SuccessorState</var>, while ''Source'' retains the excess of the combined contents of ''Source'' and ''Target'' in <var>State</var>, over the capacity of the ''Target'' jug. In either case, the contents of the unused jug are unchanged. <syntaxhighlight lang="prolog">jug_transition( State0, Capacities, empty_into(Source,Target), State1 ) :- volume( Source, State0, Content0 ), Content0 > 0, jug_permutation( Source, Target, Unused ), volume( Target, State0, Content1 ), volume( Target, Capacities, Capacity ), Content0 + Content1 =< Capacity, volume( Source, State1, 0 ), volume( Target, State1, Content2 ), Content2 is Content0 + Content1, volume( Unused, State0, Unchanged ), volume( Unused, State1, Unchanged ). jug_transition( State0, Capacities, fill_from(Source,Target), State1 ) :- volume( Source, State0, Content0 ), Content0 > 0, jug_permutation( Source, Target, Unused ), volume( Target, State0, Content1 ), volume( Target, Capacities, Capacity ), Content1 < Capacity, Content0 + Content1 > Capacity, volume( Source, State1, Content2 ), volume( Target, State1, Capacity ), Content2 is Content0 + Content1 - Capacity, volume( Unused, State0, Unchanged ), volume( Unused, State1, Unchanged ).</syntaxhighlight> ==Data Abstraction== ====volume( ?Jug, ?State, ?Volume )==== holds when <var>Jug</var> (large, small or reservoir) has <var>Volume</var> in <var>State</var>. <syntaxhighlight lang="prolog"> volume( small, jugs(Small, _Large, _Reservoir), Small ). volume( large, jugs(_Small, Large, _Reservoir), Large ). volume( reservoir, jugs(_Small, _Large, Reservoir), Reservoir ). </syntaxhighlight> ====jug_permutation( ?Source, ?Target, ?Unused )==== holds when <var>Source</var>, <var>Target</var> and <var>Unused</var> are a permutation of <code>small</code>, <code>large</code> and <code>reservoir</code>. <syntaxhighlight lang="prolog"> jug_permutation( Source, Target, Unused ) :- select( Source, [small, large, reservoir], Residue ), select( Target, Residue, [Unused] ). </syntaxhighlight> ====node_state( ?Node, ?State )==== holds when the contents of the water-jugs at <var>Node</var> are described by <var>State</var>. <syntaxhighlight lang="prolog"> node_state( start(State), State ). node_state( node(_Transition, State, _Predecessor), State ). </syntaxhighlight> ==Definite Clause Grammar== ====narrative( +Solution, +Capacities, +End )/==== is a DCG presenting the water-jugs <var>Solution</var> in a readable format. The grammar is head-recursive, because the <var>Solution</var> has the last node outermost. <syntaxhighlight lang="prolog"> narrative( start(Start), Capacities, End ) --> "Given three jugs with capacities of:", newline, literal_volumes( Capacities ), "To obtain the result:", newline, literal_volumes( End ), "Starting with:", newline, literal_volumes( Start ), "Do the following:", newline. narrative( node(Transition, Result, Predecessor), Capacities, End ) --> narrative( Predecessor, Capacities, End ), literal_action( Transition, Result ). literal_volumes( Volumes ) --> indent, literal( Volumes ), ";", newline. literal_action( Transition, Result ) --> indent, "- ", literal( Transition ), " giving:", newline, indent, indent, literal( Result ), newline. literal( empty_into(From,To) ) --> "Empty the ", literal( From ), " into the ", literal( To ). literal( fill_from(From,To) ) --> "Fill the ", literal( To ), " from the ", literal( From ). literal( jugs(Small,Large,Reservoir) ) --> literal_number( Small ), " gallons in the small jug, ", literal_number( Large ), " gallons in the large jug and ", literal_number( Reservoir ), " gallons in the reservoir". literal( small ) --> "small jug". literal( large ) --> "large jug". literal( reservoir ) --> "reservoir". literal_number( Number, Plus, Minus ) :- number( Number ), number_chars( Number, Chars ), append( Chars, Minus, Plus ). indent --> " ". newline --> " ". </syntaxhighlight> ==Utility Predicates== Load a small library of [[Puzzle Utilities]]. <syntaxhighlight lang="prolog"> :- ensure_loaded( misc ). </syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/download/water_jugs.txt here]. ==Output== The output of the program is: <div class="result"> <pre> ?- water_jugs. Given three jugs with capacities of: 3 gallons in the small jug, 4 gallons in the large jug and 8 gallons in the reservoir; To obtain the result: 0 gallons in the small jug, 2 gallons in the large jug and 6 gallons in the reservoir; Starting with: 0 gallons in the small jug, 0 gallons in the large jug and 8 gallons in the reservoir; Do the following: - Fill the small jug from the reservoir giving: 3 gallons in the small jug, 0 gallons in the large jug and 5 gallons in the reservoir - Empty the small jug into the large jug giving: 0 gallons in the small jug, 3 gallons in the large jug and 5 gallons in the reservoir - Fill the small jug from the reservoir giving: 3 gallons in the small jug, 3 gallons in the large jug and 2 gallons in the reservoir - Fill the large jug from the small jug giving: 2 gallons in the small jug, 4 gallons in the large jug and 2 gallons in the reservoir - Empty the large jug into the reservoir giving: 2 gallons in the small jug, 0 gallons in the large jug and 6 gallons in the reservoir - Empty the small jug into the large jug giving: 0 gallons in the small jug, 2 gallons in the large jug and 6 gallons in the reservoir yes </pre> </div> 396af355e53d6ea1c0c64cde8085ce322f1b0e39 117 104 2015-06-01T23:45:49Z John 2 wikitext text/x-wiki __NOTOC__ This classic AI problem is described in ''Artificial Intelligence'' as follows: <blockquote> &ldquo;You are given two jugs, a 4-gallon one and a 3-gallon one. Neither has any measuring markers on it. There is a tap that can be used to fill the jugs with water. How can you get exactly 2 gallons of water into the 4-gallon jug?&rdquo;. <cite>[http://www.amazon.co.uk/exec/obidos/ASIN/0070522634/bindingtimeli-21 E. Rich & K. Knight, Artificial Intelligence, 2nd edition, McGraw-Hill, 1991]</cite> </blockquote> This program implements an &ldquo;environmentally responsible&rdquo; solution to the ''water jugs'' problem. Rather than filling and spilling from an infinite water resource, we conserve a finite initial charge with a third jug: (reservoir). This approach is simpler than the traditional method, because there are only two actions; it is more flexible than the traditional method, because it can solve problems that are constrained by a limited supply from the reservoir. To simulate the infinite version, we use a filled reservoir with a capacity greater than the combined capacities of the jugs so that the reservoir can never be emptied. <blockquote> &ldquo;Perfection is achieved not when there is nothing more to add, but when there is nothing more to take away.&rdquo; <cite>[http://en.wikiquote.org/wiki/Antoine_de_Saint-Exupery Antoine de Saint-Exup&#233;ry]</cite> </blockquote> ==Solution== ====water_jugs==== is the entry point. The solution is derived by a simple, breadth-first, state-space search, and translated into a readable format by a DCG. <syntaxhighlight lang="prolog">water_jugs :- SmallCapacity = 3, LargeCapacity = 4, Reservoir is SmallCapacity + LargeCapacity + 1, volume( small, Capacities, SmallCapacity ), volume( large, Capacities, LargeCapacity ), volume( reservoir, Capacities, Reservoir ), volume( small, Start, 0 ), volume( large, Start, 0 ), volume( reservoir, Start, Reservoir ), volume( large, End, 2 ), water_jugs_solution( Start, Capacities, End, Solution ), phrase( narrative(Solution, Capacities, End), Chars ), put_chars( Chars ).</syntaxhighlight> ====water_jugs_solution( +Start, +Capacities, +End, ?Solution )==== holds when <var>Solution</var> is the terminal &lsquo;node&rsquo; in a state-space search - beginning with a &lsquo;start state&rsquo; in which the water-jugs have <var>Capacities</var> and contain the <var>Start</var> volumes. The terminal node is reached when the water-jugs contain the <var>End</var> volumes. <syntaxhighlight lang="prolog"> water_jugs_solution( Start, Capacities, End, Solution ) :- solve_jugs( [start(Start)], Capacities, [], End, Solution ). </syntaxhighlight> ====solve_jugs( +Nodes, +Capacities, +Visited, +End, ?Solution )==== holds when <var>Solution</var> is the terminal node in a state-space search, beginning with a first open node in <var>Nodes</var>, and terminating when the water-jugs contain the <var>End</var> volumes. <var>Capacities</var> define the capacities of the water-jugs, while <var>Visited</var> is a list of expanded (closed) node states. The breadth-first operation of solve_jugs is due to the existing <var>Nodes</var> being appended to the new nodes. (If the new nodes were appended to the existing nodes, the operation would be depth-first.) <syntaxhighlight lang="prolog"> solve_jugs( [Node|Nodes], Capacities, Visited, End, Solution ) :- node_state( Node, State ), ( State = End -> Solution = Node ; otherwise -> findall( Successor, successor(Node, Capacities, Visited, Successor), Successors ), append( Nodes, Successors, NewNodes ), solve_jugs( NewNodes, Capacities, [State|Visited], End, Solution ) ). </syntaxhighlight> ====successor( +Node, +Capacities, +Visited, ?Successor )==== <var>Successor</var> is a successor of <var>Node</var>, for water-jugs with <var>Capacities</var>, if there is a legal transition from <var>Node</var>'s state to <var>Successor</var>'s state, and <var>Successor</var>'s state is not a member of the <var>Visited</var> states. <syntaxhighlight lang="prolog"> successor( Node, Capacities, Visited, Successor ) :- node_state( Node, State ), Successor = node(Action,State1,Node), jug_transition( State, Capacities, Action, State1 ), \+ member( State1, Visited ). </syntaxhighlight> ===Transition Rules=== ====jug_transition( +State, +Capacities, ?Action, ?SuccessorState )==== holds when <var>Action</var> describes a valid transition, from <var>State</var> to <var>SuccessorState</var>, for water-jugs with <var>Capacities</var>. There are two sorts of <var>Action</var>: * <code>empty_into(Source,Target)</code> valid if ''Source'' is not already empty and the combined contents from ''Source'' and ''Target'', in <var>State</var>, are not greater than the capacity of the ''Target'' jug. The ''Source'' jug becomes empty in <var>SuccessorState</var>, while the ''Target'' jug acquires the combined contents of ''Source'' and ''Target'' in <var>State</var>. * <code>fill_from(Source,Target)</code> valid if ''Source'' is not already empty, and the combined contents from ''Source'' and ''Target'', in <var>State</var>, are greater than the capacity of the ''Target'' jug. The ''Target'' jug becomes full in <var>SuccessorState</var>, while ''Source'' retains the excess of the combined contents of ''Source'' and ''Target'' in <var>State</var>, over the capacity of the ''Target'' jug. In either case, the contents of the unused jug are unchanged. <syntaxhighlight lang="prolog">jug_transition( State0, Capacities, empty_into(Source,Target), State1 ) :- volume( Source, State0, Content0 ), Content0 > 0, jug_permutation( Source, Target, Unused ), volume( Target, State0, Content1 ), volume( Target, Capacities, Capacity ), Content0 + Content1 =< Capacity, volume( Source, State1, 0 ), volume( Target, State1, Content2 ), Content2 is Content0 + Content1, volume( Unused, State0, Unchanged ), volume( Unused, State1, Unchanged ). jug_transition( State0, Capacities, fill_from(Source,Target), State1 ) :- volume( Source, State0, Content0 ), Content0 > 0, jug_permutation( Source, Target, Unused ), volume( Target, State0, Content1 ), volume( Target, Capacities, Capacity ), Content1 < Capacity, Content0 + Content1 > Capacity, volume( Source, State1, Content2 ), volume( Target, State1, Capacity ), Content2 is Content0 + Content1 - Capacity, volume( Unused, State0, Unchanged ), volume( Unused, State1, Unchanged ).</syntaxhighlight> ==Data Abstraction== ====volume( ?Jug, ?State, ?Volume )==== holds when <var>Jug</var> (large, small or reservoir) has <var>Volume</var> in <var>State</var>. <syntaxhighlight lang="prolog"> volume( small, jugs(Small, _Large, _Reservoir), Small ). volume( large, jugs(_Small, Large, _Reservoir), Large ). volume( reservoir, jugs(_Small, _Large, Reservoir), Reservoir ). </syntaxhighlight> ====jug_permutation( ?Source, ?Target, ?Unused )==== holds when <var>Source</var>, <var>Target</var> and <var>Unused</var> are a permutation of <code>small</code>, <code>large</code> and <code>reservoir</code>. <syntaxhighlight lang="prolog"> jug_permutation( Source, Target, Unused ) :- select( Source, [small, large, reservoir], Residue ), select( Target, Residue, [Unused] ). </syntaxhighlight> ====node_state( ?Node, ?State )==== holds when the contents of the water-jugs at <var>Node</var> are described by <var>State</var>. <syntaxhighlight lang="prolog"> node_state( start(State), State ). node_state( node(_Transition, State, _Predecessor), State ). </syntaxhighlight> ==Definite Clause Grammar== ====narrative( +Solution, +Capacities, +End )/==== is a DCG presenting the water-jugs <var>Solution</var> in a readable format. The grammar is head-recursive, because the <var>Solution</var> has the last node outermost. <syntaxhighlight lang="prolog"> narrative( start(Start), Capacities, End ) --> "Given three jugs with capacities of:", newline, literal_volumes( Capacities ), "To obtain the result:", newline, literal_volumes( End ), "Starting with:", newline, literal_volumes( Start ), "Do the following:", newline. narrative( node(Transition, Result, Predecessor), Capacities, End ) --> narrative( Predecessor, Capacities, End ), literal_action( Transition, Result ). literal_volumes( Volumes ) --> indent, literal( Volumes ), ";", newline. literal_action( Transition, Result ) --> indent, "- ", literal( Transition ), " giving:", newline, indent, indent, literal( Result ), newline. literal( empty_into(From,To) ) --> "Empty the ", literal( From ), " into the ", literal( To ). literal( fill_from(From,To) ) --> "Fill the ", literal( To ), " from the ", literal( From ). literal( jugs(Small,Large,Reservoir) ) --> literal_number( Small ), " gallons in the small jug, ", literal_number( Large ), " gallons in the large jug and ", literal_number( Reservoir ), " gallons in the reservoir". literal( small ) --> "small jug". literal( large ) --> "large jug". literal( reservoir ) --> "reservoir". literal_number( Number, Plus, Minus ) :- number( Number ), number_chars( Number, Chars ), append( Chars, Minus, Plus ). indent --> " ". newline --> " ". </syntaxhighlight> ==Utility Predicates== Load a small library of [[Puzzle Utilities]]. <syntaxhighlight lang="prolog"> :- ensure_loaded( misc ). </syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/download/water_jugs.txt here]. ==Output== The output of the program is: <div class="result"> <pre> ?- water_jugs. Given three jugs with capacities of: 3 gallons in the small jug, 4 gallons in the large jug and 8 gallons in the reservoir; To obtain the result: 0 gallons in the small jug, 2 gallons in the large jug and 6 gallons in the reservoir; Starting with: 0 gallons in the small jug, 0 gallons in the large jug and 8 gallons in the reservoir; Do the following: - Fill the small jug from the reservoir giving: 3 gallons in the small jug, 0 gallons in the large jug and 5 gallons in the reservoir - Empty the small jug into the large jug giving: 0 gallons in the small jug, 3 gallons in the large jug and 5 gallons in the reservoir - Fill the small jug from the reservoir giving: 3 gallons in the small jug, 3 gallons in the large jug and 2 gallons in the reservoir - Fill the large jug from the small jug giving: 2 gallons in the small jug, 4 gallons in the large jug and 2 gallons in the reservoir - Empty the large jug into the reservoir giving: 2 gallons in the small jug, 0 gallons in the large jug and 6 gallons in the reservoir - Empty the small jug into the large jug giving: 0 gallons in the small jug, 2 gallons in the large jug and 6 gallons in the reservoir yes </pre> </div> c7556b37fbdfa54e7dc8910807c000e15fd2b600 124 117 2015-07-22T22:50:23Z John 2 Updated Antoine de Saint Exupéry link wikitext text/x-wiki __NOTOC__ This classic AI problem is described in ''Artificial Intelligence'' as follows: <blockquote> &ldquo;You are given two jugs, a 4-gallon one and a 3-gallon one. Neither has any measuring markers on it. There is a tap that can be used to fill the jugs with water. How can you get exactly 2 gallons of water into the 4-gallon jug?&rdquo;. <cite>[http://www.amazon.co.uk/exec/obidos/ASIN/0070522634/bindingtimeli-21 E. Rich & K. Knight, Artificial Intelligence, 2nd edition, McGraw-Hill, 1991]</cite> </blockquote> This program implements an &ldquo;environmentally responsible&rdquo; solution to the ''water jugs'' problem. Rather than filling and spilling from an infinite water resource, we conserve a finite initial charge with a third jug: (reservoir). This approach is simpler than the traditional method, because there are only two actions; it is more flexible than the traditional method, because it can solve problems that are constrained by a limited supply from the reservoir. To simulate the infinite version, we use a filled reservoir with a capacity greater than the combined capacities of the jugs so that the reservoir can never be emptied. <blockquote> &ldquo;Perfection is achieved not when there is nothing more to add, but when there is nothing more to take away.&rdquo; <cite>[https://en.wikiquote.org/w/index.php?title=Antoine_de_Saint_Exupéry Antoine de Saint-Exup&#233;ry]</cite> </blockquote> ==Solution== ====water_jugs==== is the entry point. The solution is derived by a simple, breadth-first, state-space search, and translated into a readable format by a DCG. <syntaxhighlight lang="prolog">water_jugs :- SmallCapacity = 3, LargeCapacity = 4, Reservoir is SmallCapacity + LargeCapacity + 1, volume( small, Capacities, SmallCapacity ), volume( large, Capacities, LargeCapacity ), volume( reservoir, Capacities, Reservoir ), volume( small, Start, 0 ), volume( large, Start, 0 ), volume( reservoir, Start, Reservoir ), volume( large, End, 2 ), water_jugs_solution( Start, Capacities, End, Solution ), phrase( narrative(Solution, Capacities, End), Chars ), put_chars( Chars ).</syntaxhighlight> ====water_jugs_solution( +Start, +Capacities, +End, ?Solution )==== holds when <var>Solution</var> is the terminal &lsquo;node&rsquo; in a state-space search - beginning with a &lsquo;start state&rsquo; in which the water-jugs have <var>Capacities</var> and contain the <var>Start</var> volumes. The terminal node is reached when the water-jugs contain the <var>End</var> volumes. <syntaxhighlight lang="prolog"> water_jugs_solution( Start, Capacities, End, Solution ) :- solve_jugs( [start(Start)], Capacities, [], End, Solution ). </syntaxhighlight> ====solve_jugs( +Nodes, +Capacities, +Visited, +End, ?Solution )==== holds when <var>Solution</var> is the terminal node in a state-space search, beginning with a first open node in <var>Nodes</var>, and terminating when the water-jugs contain the <var>End</var> volumes. <var>Capacities</var> define the capacities of the water-jugs, while <var>Visited</var> is a list of expanded (closed) node states. The breadth-first operation of solve_jugs is due to the existing <var>Nodes</var> being appended to the new nodes. (If the new nodes were appended to the existing nodes, the operation would be depth-first.) <syntaxhighlight lang="prolog"> solve_jugs( [Node|Nodes], Capacities, Visited, End, Solution ) :- node_state( Node, State ), ( State = End -> Solution = Node ; otherwise -> findall( Successor, successor(Node, Capacities, Visited, Successor), Successors ), append( Nodes, Successors, NewNodes ), solve_jugs( NewNodes, Capacities, [State|Visited], End, Solution ) ). </syntaxhighlight> ====successor( +Node, +Capacities, +Visited, ?Successor )==== <var>Successor</var> is a successor of <var>Node</var>, for water-jugs with <var>Capacities</var>, if there is a legal transition from <var>Node</var>'s state to <var>Successor</var>'s state, and <var>Successor</var>'s state is not a member of the <var>Visited</var> states. <syntaxhighlight lang="prolog"> successor( Node, Capacities, Visited, Successor ) :- node_state( Node, State ), Successor = node(Action,State1,Node), jug_transition( State, Capacities, Action, State1 ), \+ member( State1, Visited ). </syntaxhighlight> ===Transition Rules=== ====jug_transition( +State, +Capacities, ?Action, ?SuccessorState )==== holds when <var>Action</var> describes a valid transition, from <var>State</var> to <var>SuccessorState</var>, for water-jugs with <var>Capacities</var>. There are two sorts of <var>Action</var>: * <code>empty_into(Source,Target)</code> valid if ''Source'' is not already empty and the combined contents from ''Source'' and ''Target'', in <var>State</var>, are not greater than the capacity of the ''Target'' jug. The ''Source'' jug becomes empty in <var>SuccessorState</var>, while the ''Target'' jug acquires the combined contents of ''Source'' and ''Target'' in <var>State</var>. * <code>fill_from(Source,Target)</code> valid if ''Source'' is not already empty, and the combined contents from ''Source'' and ''Target'', in <var>State</var>, are greater than the capacity of the ''Target'' jug. The ''Target'' jug becomes full in <var>SuccessorState</var>, while ''Source'' retains the excess of the combined contents of ''Source'' and ''Target'' in <var>State</var>, over the capacity of the ''Target'' jug. In either case, the contents of the unused jug are unchanged. <syntaxhighlight lang="prolog">jug_transition( State0, Capacities, empty_into(Source,Target), State1 ) :- volume( Source, State0, Content0 ), Content0 > 0, jug_permutation( Source, Target, Unused ), volume( Target, State0, Content1 ), volume( Target, Capacities, Capacity ), Content0 + Content1 =< Capacity, volume( Source, State1, 0 ), volume( Target, State1, Content2 ), Content2 is Content0 + Content1, volume( Unused, State0, Unchanged ), volume( Unused, State1, Unchanged ). jug_transition( State0, Capacities, fill_from(Source,Target), State1 ) :- volume( Source, State0, Content0 ), Content0 > 0, jug_permutation( Source, Target, Unused ), volume( Target, State0, Content1 ), volume( Target, Capacities, Capacity ), Content1 < Capacity, Content0 + Content1 > Capacity, volume( Source, State1, Content2 ), volume( Target, State1, Capacity ), Content2 is Content0 + Content1 - Capacity, volume( Unused, State0, Unchanged ), volume( Unused, State1, Unchanged ).</syntaxhighlight> ==Data Abstraction== ====volume( ?Jug, ?State, ?Volume )==== holds when <var>Jug</var> (large, small or reservoir) has <var>Volume</var> in <var>State</var>. <syntaxhighlight lang="prolog"> volume( small, jugs(Small, _Large, _Reservoir), Small ). volume( large, jugs(_Small, Large, _Reservoir), Large ). volume( reservoir, jugs(_Small, _Large, Reservoir), Reservoir ). </syntaxhighlight> ====jug_permutation( ?Source, ?Target, ?Unused )==== holds when <var>Source</var>, <var>Target</var> and <var>Unused</var> are a permutation of <code>small</code>, <code>large</code> and <code>reservoir</code>. <syntaxhighlight lang="prolog"> jug_permutation( Source, Target, Unused ) :- select( Source, [small, large, reservoir], Residue ), select( Target, Residue, [Unused] ). </syntaxhighlight> ====node_state( ?Node, ?State )==== holds when the contents of the water-jugs at <var>Node</var> are described by <var>State</var>. <syntaxhighlight lang="prolog"> node_state( start(State), State ). node_state( node(_Transition, State, _Predecessor), State ). </syntaxhighlight> ==Definite Clause Grammar== ====narrative( +Solution, +Capacities, +End )/==== is a DCG presenting the water-jugs <var>Solution</var> in a readable format. The grammar is head-recursive, because the <var>Solution</var> has the last node outermost. <syntaxhighlight lang="prolog"> narrative( start(Start), Capacities, End ) --> "Given three jugs with capacities of:", newline, literal_volumes( Capacities ), "To obtain the result:", newline, literal_volumes( End ), "Starting with:", newline, literal_volumes( Start ), "Do the following:", newline. narrative( node(Transition, Result, Predecessor), Capacities, End ) --> narrative( Predecessor, Capacities, End ), literal_action( Transition, Result ). literal_volumes( Volumes ) --> indent, literal( Volumes ), ";", newline. literal_action( Transition, Result ) --> indent, "- ", literal( Transition ), " giving:", newline, indent, indent, literal( Result ), newline. literal( empty_into(From,To) ) --> "Empty the ", literal( From ), " into the ", literal( To ). literal( fill_from(From,To) ) --> "Fill the ", literal( To ), " from the ", literal( From ). literal( jugs(Small,Large,Reservoir) ) --> literal_number( Small ), " gallons in the small jug, ", literal_number( Large ), " gallons in the large jug and ", literal_number( Reservoir ), " gallons in the reservoir". literal( small ) --> "small jug". literal( large ) --> "large jug". literal( reservoir ) --> "reservoir". literal_number( Number, Plus, Minus ) :- number( Number ), number_chars( Number, Chars ), append( Chars, Minus, Plus ). indent --> " ". newline --> " ". </syntaxhighlight> ==Utility Predicates== Load a small library of [[Puzzle Utilities]]. <syntaxhighlight lang="prolog"> :- ensure_loaded( misc ). </syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/download/water_jugs.txt here]. ==Output== The output of the program is: <div class="result"> <pre> ?- water_jugs. Given three jugs with capacities of: 3 gallons in the small jug, 4 gallons in the large jug and 8 gallons in the reservoir; To obtain the result: 0 gallons in the small jug, 2 gallons in the large jug and 6 gallons in the reservoir; Starting with: 0 gallons in the small jug, 0 gallons in the large jug and 8 gallons in the reservoir; Do the following: - Fill the small jug from the reservoir giving: 3 gallons in the small jug, 0 gallons in the large jug and 5 gallons in the reservoir - Empty the small jug into the large jug giving: 0 gallons in the small jug, 3 gallons in the large jug and 5 gallons in the reservoir - Fill the small jug from the reservoir giving: 3 gallons in the small jug, 3 gallons in the large jug and 2 gallons in the reservoir - Fill the large jug from the small jug giving: 2 gallons in the small jug, 4 gallons in the large jug and 2 gallons in the reservoir - Empty the large jug into the reservoir giving: 2 gallons in the small jug, 0 gallons in the large jug and 6 gallons in the reservoir - Empty the small jug into the large jug giving: 0 gallons in the small jug, 2 gallons in the large jug and 6 gallons in the reservoir yes </pre> </div> 64308e943370e347e0a2a7a23538b23c358c149f 145 124 2016-04-20T21:11:32Z John 2 Amazon link updated wikitext text/x-wiki __NOTOC__ This classic AI problem is described in ''Artificial Intelligence'' as follows: <blockquote> &ldquo;You are given two jugs, a 4-gallon one and a 3-gallon one. Neither has any measuring markers on it. There is a tap that can be used to fill the jugs with water. How can you get exactly 2 gallons of water into the 4-gallon jug?&rdquo;. <cite>[https://www.amazon.co.uk/Artificial-Intelligence-Elaine-Rich/dp/0070522634/276-9442056-6625664?tag=bindingtimeli-21 E. Rich & K. Knight, Artificial Intelligence, 2nd edition, McGraw-Hill, 1991]</cite> </blockquote> This program implements an &ldquo;environmentally responsible&rdquo; solution to the ''water jugs'' problem. Rather than filling and spilling from an infinite water resource, we conserve a finite initial charge with a third jug: (reservoir). This approach is simpler than the traditional method, because there are only two actions; it is more flexible than the traditional method, because it can solve problems that are constrained by a limited supply from the reservoir. To simulate the infinite version, we use a filled reservoir with a capacity greater than the combined capacities of the jugs so that the reservoir can never be emptied. <blockquote> &ldquo;Perfection is achieved not when there is nothing more to add, but when there is nothing more to take away.&rdquo; <cite>[https://en.wikiquote.org/w/index.php?title=Antoine_de_Saint_Exupéry Antoine de Saint-Exup&#233;ry]</cite> </blockquote> ==Solution== ====water_jugs==== is the entry point. The solution is derived by a simple, breadth-first, state-space search, and translated into a readable format by a DCG. <syntaxhighlight lang="prolog">water_jugs :- SmallCapacity = 3, LargeCapacity = 4, Reservoir is SmallCapacity + LargeCapacity + 1, volume( small, Capacities, SmallCapacity ), volume( large, Capacities, LargeCapacity ), volume( reservoir, Capacities, Reservoir ), volume( small, Start, 0 ), volume( large, Start, 0 ), volume( reservoir, Start, Reservoir ), volume( large, End, 2 ), water_jugs_solution( Start, Capacities, End, Solution ), phrase( narrative(Solution, Capacities, End), Chars ), put_chars( Chars ).</syntaxhighlight> ====water_jugs_solution( +Start, +Capacities, +End, ?Solution )==== holds when <var>Solution</var> is the terminal &lsquo;node&rsquo; in a state-space search - beginning with a &lsquo;start state&rsquo; in which the water-jugs have <var>Capacities</var> and contain the <var>Start</var> volumes. The terminal node is reached when the water-jugs contain the <var>End</var> volumes. <syntaxhighlight lang="prolog"> water_jugs_solution( Start, Capacities, End, Solution ) :- solve_jugs( [start(Start)], Capacities, [], End, Solution ). </syntaxhighlight> ====solve_jugs( +Nodes, +Capacities, +Visited, +End, ?Solution )==== holds when <var>Solution</var> is the terminal node in a state-space search, beginning with a first open node in <var>Nodes</var>, and terminating when the water-jugs contain the <var>End</var> volumes. <var>Capacities</var> define the capacities of the water-jugs, while <var>Visited</var> is a list of expanded (closed) node states. The breadth-first operation of solve_jugs is due to the existing <var>Nodes</var> being appended to the new nodes. (If the new nodes were appended to the existing nodes, the operation would be depth-first.) <syntaxhighlight lang="prolog"> solve_jugs( [Node|Nodes], Capacities, Visited, End, Solution ) :- node_state( Node, State ), ( State = End -> Solution = Node ; otherwise -> findall( Successor, successor(Node, Capacities, Visited, Successor), Successors ), append( Nodes, Successors, NewNodes ), solve_jugs( NewNodes, Capacities, [State|Visited], End, Solution ) ). </syntaxhighlight> ====successor( +Node, +Capacities, +Visited, ?Successor )==== <var>Successor</var> is a successor of <var>Node</var>, for water-jugs with <var>Capacities</var>, if there is a legal transition from <var>Node</var>'s state to <var>Successor</var>'s state, and <var>Successor</var>'s state is not a member of the <var>Visited</var> states. <syntaxhighlight lang="prolog"> successor( Node, Capacities, Visited, Successor ) :- node_state( Node, State ), Successor = node(Action,State1,Node), jug_transition( State, Capacities, Action, State1 ), \+ member( State1, Visited ). </syntaxhighlight> ===Transition Rules=== ====jug_transition( +State, +Capacities, ?Action, ?SuccessorState )==== holds when <var>Action</var> describes a valid transition, from <var>State</var> to <var>SuccessorState</var>, for water-jugs with <var>Capacities</var>. There are two sorts of <var>Action</var>: * <code>empty_into(Source,Target)</code> valid if ''Source'' is not already empty and the combined contents from ''Source'' and ''Target'', in <var>State</var>, are not greater than the capacity of the ''Target'' jug. The ''Source'' jug becomes empty in <var>SuccessorState</var>, while the ''Target'' jug acquires the combined contents of ''Source'' and ''Target'' in <var>State</var>. * <code>fill_from(Source,Target)</code> valid if ''Source'' is not already empty, and the combined contents from ''Source'' and ''Target'', in <var>State</var>, are greater than the capacity of the ''Target'' jug. The ''Target'' jug becomes full in <var>SuccessorState</var>, while ''Source'' retains the excess of the combined contents of ''Source'' and ''Target'' in <var>State</var>, over the capacity of the ''Target'' jug. In either case, the contents of the unused jug are unchanged. <syntaxhighlight lang="prolog">jug_transition( State0, Capacities, empty_into(Source,Target), State1 ) :- volume( Source, State0, Content0 ), Content0 > 0, jug_permutation( Source, Target, Unused ), volume( Target, State0, Content1 ), volume( Target, Capacities, Capacity ), Content0 + Content1 =< Capacity, volume( Source, State1, 0 ), volume( Target, State1, Content2 ), Content2 is Content0 + Content1, volume( Unused, State0, Unchanged ), volume( Unused, State1, Unchanged ). jug_transition( State0, Capacities, fill_from(Source,Target), State1 ) :- volume( Source, State0, Content0 ), Content0 > 0, jug_permutation( Source, Target, Unused ), volume( Target, State0, Content1 ), volume( Target, Capacities, Capacity ), Content1 < Capacity, Content0 + Content1 > Capacity, volume( Source, State1, Content2 ), volume( Target, State1, Capacity ), Content2 is Content0 + Content1 - Capacity, volume( Unused, State0, Unchanged ), volume( Unused, State1, Unchanged ).</syntaxhighlight> ==Data Abstraction== ====volume( ?Jug, ?State, ?Volume )==== holds when <var>Jug</var> (large, small or reservoir) has <var>Volume</var> in <var>State</var>. <syntaxhighlight lang="prolog"> volume( small, jugs(Small, _Large, _Reservoir), Small ). volume( large, jugs(_Small, Large, _Reservoir), Large ). volume( reservoir, jugs(_Small, _Large, Reservoir), Reservoir ). </syntaxhighlight> ====jug_permutation( ?Source, ?Target, ?Unused )==== holds when <var>Source</var>, <var>Target</var> and <var>Unused</var> are a permutation of <code>small</code>, <code>large</code> and <code>reservoir</code>. <syntaxhighlight lang="prolog"> jug_permutation( Source, Target, Unused ) :- select( Source, [small, large, reservoir], Residue ), select( Target, Residue, [Unused] ). </syntaxhighlight> ====node_state( ?Node, ?State )==== holds when the contents of the water-jugs at <var>Node</var> are described by <var>State</var>. <syntaxhighlight lang="prolog"> node_state( start(State), State ). node_state( node(_Transition, State, _Predecessor), State ). </syntaxhighlight> ==Definite Clause Grammar== ====narrative( +Solution, +Capacities, +End )/==== is a DCG presenting the water-jugs <var>Solution</var> in a readable format. The grammar is head-recursive, because the <var>Solution</var> has the last node outermost. <syntaxhighlight lang="prolog"> narrative( start(Start), Capacities, End ) --> "Given three jugs with capacities of:", newline, literal_volumes( Capacities ), "To obtain the result:", newline, literal_volumes( End ), "Starting with:", newline, literal_volumes( Start ), "Do the following:", newline. narrative( node(Transition, Result, Predecessor), Capacities, End ) --> narrative( Predecessor, Capacities, End ), literal_action( Transition, Result ). literal_volumes( Volumes ) --> indent, literal( Volumes ), ";", newline. literal_action( Transition, Result ) --> indent, "- ", literal( Transition ), " giving:", newline, indent, indent, literal( Result ), newline. literal( empty_into(From,To) ) --> "Empty the ", literal( From ), " into the ", literal( To ). literal( fill_from(From,To) ) --> "Fill the ", literal( To ), " from the ", literal( From ). literal( jugs(Small,Large,Reservoir) ) --> literal_number( Small ), " gallons in the small jug, ", literal_number( Large ), " gallons in the large jug and ", literal_number( Reservoir ), " gallons in the reservoir". literal( small ) --> "small jug". literal( large ) --> "large jug". literal( reservoir ) --> "reservoir". literal_number( Number, Plus, Minus ) :- number( Number ), number_chars( Number, Chars ), append( Chars, Minus, Plus ). indent --> " ". newline --> " ". </syntaxhighlight> ==Utility Predicates== Load a small library of [[Puzzle Utilities]]. <syntaxhighlight lang="prolog"> :- ensure_loaded( misc ). </syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/download/water_jugs.txt here]. ==Output== The output of the program is: <div class="result"> <pre> ?- water_jugs. Given three jugs with capacities of: 3 gallons in the small jug, 4 gallons in the large jug and 8 gallons in the reservoir; To obtain the result: 0 gallons in the small jug, 2 gallons in the large jug and 6 gallons in the reservoir; Starting with: 0 gallons in the small jug, 0 gallons in the large jug and 8 gallons in the reservoir; Do the following: - Fill the small jug from the reservoir giving: 3 gallons in the small jug, 0 gallons in the large jug and 5 gallons in the reservoir - Empty the small jug into the large jug giving: 0 gallons in the small jug, 3 gallons in the large jug and 5 gallons in the reservoir - Fill the small jug from the reservoir giving: 3 gallons in the small jug, 3 gallons in the large jug and 2 gallons in the reservoir - Fill the large jug from the small jug giving: 2 gallons in the small jug, 4 gallons in the large jug and 2 gallons in the reservoir - Empty the large jug into the reservoir giving: 2 gallons in the small jug, 0 gallons in the large jug and 6 gallons in the reservoir - Empty the small jug into the large jug giving: 0 gallons in the small jug, 2 gallons in the large jug and 6 gallons in the reservoir yes </pre> </div> 724773502d6df936ad06e4ae98f6eb1f1ac6b0fc 147 145 2016-04-27T22:40:48Z John 2 Updated Antoine de Saint Exupéry Wikiquote link wikitext text/x-wiki __NOTOC__ This classic AI problem is described in ''Artificial Intelligence'' as follows: <blockquote> &ldquo;You are given two jugs, a 4-gallon one and a 3-gallon one. Neither has any measuring markers on it. There is a tap that can be used to fill the jugs with water. How can you get exactly 2 gallons of water into the 4-gallon jug?&rdquo;. <cite>[https://www.amazon.co.uk/Artificial-Intelligence-Elaine-Rich/dp/0070522634/276-9442056-6625664?tag=bindingtimeli-21 E. Rich & K. Knight, Artificial Intelligence, 2nd edition, McGraw-Hill, 1991]</cite> </blockquote> This program implements an &ldquo;environmentally responsible&rdquo; solution to the ''water jugs'' problem. Rather than filling and spilling from an infinite water resource, we conserve a finite initial charge with a third jug: (reservoir). This approach is simpler than the traditional method, because there are only two actions; it is more flexible than the traditional method, because it can solve problems that are constrained by a limited supply from the reservoir. To simulate the infinite version, we use a filled reservoir with a capacity greater than the combined capacities of the jugs so that the reservoir can never be emptied. <blockquote> &ldquo;Perfection is achieved not when there is nothing more to add, but when there is nothing more to take away.&rdquo; <cite>[https://en.wikiquote.org/wiki/Antoine_de_Saint_Exup%C3%A9ry Antoine de Saint-Exup&#233;ry]</cite> </blockquote> ==Solution== ====water_jugs==== is the entry point. The solution is derived by a simple, breadth-first, state-space search, and translated into a readable format by a DCG. <syntaxhighlight lang="prolog">water_jugs :- SmallCapacity = 3, LargeCapacity = 4, Reservoir is SmallCapacity + LargeCapacity + 1, volume( small, Capacities, SmallCapacity ), volume( large, Capacities, LargeCapacity ), volume( reservoir, Capacities, Reservoir ), volume( small, Start, 0 ), volume( large, Start, 0 ), volume( reservoir, Start, Reservoir ), volume( large, End, 2 ), water_jugs_solution( Start, Capacities, End, Solution ), phrase( narrative(Solution, Capacities, End), Chars ), put_chars( Chars ).</syntaxhighlight> ====water_jugs_solution( +Start, +Capacities, +End, ?Solution )==== holds when <var>Solution</var> is the terminal &lsquo;node&rsquo; in a state-space search - beginning with a &lsquo;start state&rsquo; in which the water-jugs have <var>Capacities</var> and contain the <var>Start</var> volumes. The terminal node is reached when the water-jugs contain the <var>End</var> volumes. <syntaxhighlight lang="prolog"> water_jugs_solution( Start, Capacities, End, Solution ) :- solve_jugs( [start(Start)], Capacities, [], End, Solution ). </syntaxhighlight> ====solve_jugs( +Nodes, +Capacities, +Visited, +End, ?Solution )==== holds when <var>Solution</var> is the terminal node in a state-space search, beginning with a first open node in <var>Nodes</var>, and terminating when the water-jugs contain the <var>End</var> volumes. <var>Capacities</var> define the capacities of the water-jugs, while <var>Visited</var> is a list of expanded (closed) node states. The breadth-first operation of solve_jugs is due to the existing <var>Nodes</var> being appended to the new nodes. (If the new nodes were appended to the existing nodes, the operation would be depth-first.) <syntaxhighlight lang="prolog"> solve_jugs( [Node|Nodes], Capacities, Visited, End, Solution ) :- node_state( Node, State ), ( State = End -> Solution = Node ; otherwise -> findall( Successor, successor(Node, Capacities, Visited, Successor), Successors ), append( Nodes, Successors, NewNodes ), solve_jugs( NewNodes, Capacities, [State|Visited], End, Solution ) ). </syntaxhighlight> ====successor( +Node, +Capacities, +Visited, ?Successor )==== <var>Successor</var> is a successor of <var>Node</var>, for water-jugs with <var>Capacities</var>, if there is a legal transition from <var>Node</var>'s state to <var>Successor</var>'s state, and <var>Successor</var>'s state is not a member of the <var>Visited</var> states. <syntaxhighlight lang="prolog"> successor( Node, Capacities, Visited, Successor ) :- node_state( Node, State ), Successor = node(Action,State1,Node), jug_transition( State, Capacities, Action, State1 ), \+ member( State1, Visited ). </syntaxhighlight> ===Transition Rules=== ====jug_transition( +State, +Capacities, ?Action, ?SuccessorState )==== holds when <var>Action</var> describes a valid transition, from <var>State</var> to <var>SuccessorState</var>, for water-jugs with <var>Capacities</var>. There are two sorts of <var>Action</var>: * <code>empty_into(Source,Target)</code> valid if ''Source'' is not already empty and the combined contents from ''Source'' and ''Target'', in <var>State</var>, are not greater than the capacity of the ''Target'' jug. The ''Source'' jug becomes empty in <var>SuccessorState</var>, while the ''Target'' jug acquires the combined contents of ''Source'' and ''Target'' in <var>State</var>. * <code>fill_from(Source,Target)</code> valid if ''Source'' is not already empty, and the combined contents from ''Source'' and ''Target'', in <var>State</var>, are greater than the capacity of the ''Target'' jug. The ''Target'' jug becomes full in <var>SuccessorState</var>, while ''Source'' retains the excess of the combined contents of ''Source'' and ''Target'' in <var>State</var>, over the capacity of the ''Target'' jug. In either case, the contents of the unused jug are unchanged. <syntaxhighlight lang="prolog">jug_transition( State0, Capacities, empty_into(Source,Target), State1 ) :- volume( Source, State0, Content0 ), Content0 > 0, jug_permutation( Source, Target, Unused ), volume( Target, State0, Content1 ), volume( Target, Capacities, Capacity ), Content0 + Content1 =< Capacity, volume( Source, State1, 0 ), volume( Target, State1, Content2 ), Content2 is Content0 + Content1, volume( Unused, State0, Unchanged ), volume( Unused, State1, Unchanged ). jug_transition( State0, Capacities, fill_from(Source,Target), State1 ) :- volume( Source, State0, Content0 ), Content0 > 0, jug_permutation( Source, Target, Unused ), volume( Target, State0, Content1 ), volume( Target, Capacities, Capacity ), Content1 < Capacity, Content0 + Content1 > Capacity, volume( Source, State1, Content2 ), volume( Target, State1, Capacity ), Content2 is Content0 + Content1 - Capacity, volume( Unused, State0, Unchanged ), volume( Unused, State1, Unchanged ).</syntaxhighlight> ==Data Abstraction== ====volume( ?Jug, ?State, ?Volume )==== holds when <var>Jug</var> (large, small or reservoir) has <var>Volume</var> in <var>State</var>. <syntaxhighlight lang="prolog"> volume( small, jugs(Small, _Large, _Reservoir), Small ). volume( large, jugs(_Small, Large, _Reservoir), Large ). volume( reservoir, jugs(_Small, _Large, Reservoir), Reservoir ). </syntaxhighlight> ====jug_permutation( ?Source, ?Target, ?Unused )==== holds when <var>Source</var>, <var>Target</var> and <var>Unused</var> are a permutation of <code>small</code>, <code>large</code> and <code>reservoir</code>. <syntaxhighlight lang="prolog"> jug_permutation( Source, Target, Unused ) :- select( Source, [small, large, reservoir], Residue ), select( Target, Residue, [Unused] ). </syntaxhighlight> ====node_state( ?Node, ?State )==== holds when the contents of the water-jugs at <var>Node</var> are described by <var>State</var>. <syntaxhighlight lang="prolog"> node_state( start(State), State ). node_state( node(_Transition, State, _Predecessor), State ). </syntaxhighlight> ==Definite Clause Grammar== ====narrative( +Solution, +Capacities, +End )/==== is a DCG presenting the water-jugs <var>Solution</var> in a readable format. The grammar is head-recursive, because the <var>Solution</var> has the last node outermost. <syntaxhighlight lang="prolog"> narrative( start(Start), Capacities, End ) --> "Given three jugs with capacities of:", newline, literal_volumes( Capacities ), "To obtain the result:", newline, literal_volumes( End ), "Starting with:", newline, literal_volumes( Start ), "Do the following:", newline. narrative( node(Transition, Result, Predecessor), Capacities, End ) --> narrative( Predecessor, Capacities, End ), literal_action( Transition, Result ). literal_volumes( Volumes ) --> indent, literal( Volumes ), ";", newline. literal_action( Transition, Result ) --> indent, "- ", literal( Transition ), " giving:", newline, indent, indent, literal( Result ), newline. literal( empty_into(From,To) ) --> "Empty the ", literal( From ), " into the ", literal( To ). literal( fill_from(From,To) ) --> "Fill the ", literal( To ), " from the ", literal( From ). literal( jugs(Small,Large,Reservoir) ) --> literal_number( Small ), " gallons in the small jug, ", literal_number( Large ), " gallons in the large jug and ", literal_number( Reservoir ), " gallons in the reservoir". literal( small ) --> "small jug". literal( large ) --> "large jug". literal( reservoir ) --> "reservoir". literal_number( Number, Plus, Minus ) :- number( Number ), number_chars( Number, Chars ), append( Chars, Minus, Plus ). indent --> " ". newline --> " ". </syntaxhighlight> ==Utility Predicates== Load a small library of [[Puzzle Utilities]]. <syntaxhighlight lang="prolog"> :- ensure_loaded( misc ). </syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/download/water_jugs.txt here]. ==Output== The output of the program is: <div class="result"> <pre> ?- water_jugs. Given three jugs with capacities of: 3 gallons in the small jug, 4 gallons in the large jug and 8 gallons in the reservoir; To obtain the result: 0 gallons in the small jug, 2 gallons in the large jug and 6 gallons in the reservoir; Starting with: 0 gallons in the small jug, 0 gallons in the large jug and 8 gallons in the reservoir; Do the following: - Fill the small jug from the reservoir giving: 3 gallons in the small jug, 0 gallons in the large jug and 5 gallons in the reservoir - Empty the small jug into the large jug giving: 0 gallons in the small jug, 3 gallons in the large jug and 5 gallons in the reservoir - Fill the small jug from the reservoir giving: 3 gallons in the small jug, 3 gallons in the large jug and 2 gallons in the reservoir - Fill the large jug from the small jug giving: 2 gallons in the small jug, 4 gallons in the large jug and 2 gallons in the reservoir - Empty the large jug into the reservoir giving: 2 gallons in the small jug, 0 gallons in the large jug and 6 gallons in the reservoir - Empty the small jug into the large jug giving: 0 gallons in the small jug, 2 gallons in the large jug and 6 gallons in the reservoir yes </pre> </div> 7234945534611d5850d2880759372bacd32aa762 148 147 2016-05-03T22:40:43Z John 2 Removing some superfluous commas. wikitext text/x-wiki __NOTOC__ This classic AI problem is described in ''Artificial Intelligence'' as follows: <blockquote> &ldquo;You are given two jugs, a 4-gallon one and a 3-gallon one. Neither has any measuring markers on it. There is a tap that can be used to fill the jugs with water. How can you get exactly 2 gallons of water into the 4-gallon jug?&rdquo;. <cite>[https://www.amazon.co.uk/Artificial-Intelligence-Elaine-Rich/dp/0070522634/276-9442056-6625664?tag=bindingtimeli-21 E. Rich & K. Knight, Artificial Intelligence, 2nd edition, McGraw-Hill, 1991]</cite> </blockquote> This program implements an &ldquo;environmentally responsible&rdquo; solution to the ''water jugs'' problem. Rather than filling and spilling from an infinite water resource, we conserve a finite initial charge with a third jug: (reservoir). This approach is simpler than the traditional method because there are only two actions. It is more flexible than the traditional method because it can solve problems that are constrained by a limited supply from the reservoir. To simulate the infinite version, we use a filled reservoir with a capacity greater than the combined capacities of the jugs so that the reservoir can never be emptied. <blockquote> &ldquo;Perfection is achieved not when there is nothing more to add, but when there is nothing more to take away.&rdquo; <cite>[https://en.wikiquote.org/wiki/Antoine_de_Saint_Exup%C3%A9ry Antoine de Saint-Exup&#233;ry]</cite> </blockquote> ==Solution== ====water_jugs==== is the entry point. The solution is derived by a simple, breadth-first, state-space search, and translated into a readable format by a DCG. <syntaxhighlight lang="prolog">water_jugs :- SmallCapacity = 3, LargeCapacity = 4, Reservoir is SmallCapacity + LargeCapacity + 1, volume( small, Capacities, SmallCapacity ), volume( large, Capacities, LargeCapacity ), volume( reservoir, Capacities, Reservoir ), volume( small, Start, 0 ), volume( large, Start, 0 ), volume( reservoir, Start, Reservoir ), volume( large, End, 2 ), water_jugs_solution( Start, Capacities, End, Solution ), phrase( narrative(Solution, Capacities, End), Chars ), put_chars( Chars ).</syntaxhighlight> ====water_jugs_solution( +Start, +Capacities, +End, ?Solution )==== holds when <var>Solution</var> is the terminal &lsquo;node&rsquo; in a state-space search - beginning with a &lsquo;start state&rsquo; in which the water-jugs have <var>Capacities</var> and contain the <var>Start</var> volumes. The terminal node is reached when the water-jugs contain the <var>End</var> volumes. <syntaxhighlight lang="prolog"> water_jugs_solution( Start, Capacities, End, Solution ) :- solve_jugs( [start(Start)], Capacities, [], End, Solution ). </syntaxhighlight> ====solve_jugs( +Nodes, +Capacities, +Visited, +End, ?Solution )==== holds when <var>Solution</var> is the terminal node in a state-space search, beginning with a first open node in <var>Nodes</var>, and terminating when the water-jugs contain the <var>End</var> volumes. <var>Capacities</var> define the capacities of the water-jugs while <var>Visited</var> is a list of expanded (closed) node states. The breadth-first operation of solve_jugs is due to the existing <var>Nodes</var> being appended to the new nodes. (If the new nodes were appended to the existing nodes, the operation would be depth-first.) <syntaxhighlight lang="prolog"> solve_jugs( [Node|Nodes], Capacities, Visited, End, Solution ) :- node_state( Node, State ), ( State = End -> Solution = Node ; otherwise -> findall( Successor, successor(Node, Capacities, Visited, Successor), Successors ), append( Nodes, Successors, NewNodes ), solve_jugs( NewNodes, Capacities, [State|Visited], End, Solution ) ). </syntaxhighlight> ====successor( +Node, +Capacities, +Visited, ?Successor )==== <var>Successor</var> is a successor of <var>Node</var>, for water-jugs with <var>Capacities</var>, if there is a legal transition from <var>Node</var>'s state to <var>Successor</var>'s state, and <var>Successor</var>'s state is not a member of the <var>Visited</var> states. <syntaxhighlight lang="prolog"> successor( Node, Capacities, Visited, Successor ) :- node_state( Node, State ), Successor = node(Action,State1,Node), jug_transition( State, Capacities, Action, State1 ), \+ member( State1, Visited ). </syntaxhighlight> ===Transition Rules=== ====jug_transition( +State, +Capacities, ?Action, ?SuccessorState )==== holds when <var>Action</var> describes a valid transition, from <var>State</var> to <var>SuccessorState</var>, for water-jugs with <var>Capacities</var>. There are two sorts of <var>Action</var>: * <code>empty_into(Source,Target)</code> valid if ''Source'' is not already empty and the combined contents from ''Source'' and ''Target'', in <var>State</var>, are not greater than the capacity of the ''Target'' jug. The ''Source'' jug becomes empty in <var>SuccessorState</var> while the ''Target'' jug acquires the combined contents of ''Source'' and ''Target'' in <var>State</var>. * <code>fill_from(Source,Target)</code> valid if ''Source'' is not already empty, and the combined contents from ''Source'' and ''Target'', in <var>State</var>, are greater than the capacity of the ''Target'' jug. The ''Target'' jug becomes full in <var>SuccessorState</var>, while ''Source'' retains the excess of the combined contents of ''Source'' and ''Target'' in <var>State</var>, over the capacity of the ''Target'' jug. In either case, the contents of the unused jug are unchanged. <syntaxhighlight lang="prolog">jug_transition( State0, Capacities, empty_into(Source,Target), State1 ) :- volume( Source, State0, Content0 ), Content0 > 0, jug_permutation( Source, Target, Unused ), volume( Target, State0, Content1 ), volume( Target, Capacities, Capacity ), Content0 + Content1 =< Capacity, volume( Source, State1, 0 ), volume( Target, State1, Content2 ), Content2 is Content0 + Content1, volume( Unused, State0, Unchanged ), volume( Unused, State1, Unchanged ). jug_transition( State0, Capacities, fill_from(Source,Target), State1 ) :- volume( Source, State0, Content0 ), Content0 > 0, jug_permutation( Source, Target, Unused ), volume( Target, State0, Content1 ), volume( Target, Capacities, Capacity ), Content1 < Capacity, Content0 + Content1 > Capacity, volume( Source, State1, Content2 ), volume( Target, State1, Capacity ), Content2 is Content0 + Content1 - Capacity, volume( Unused, State0, Unchanged ), volume( Unused, State1, Unchanged ).</syntaxhighlight> ==Data Abstraction== ====volume( ?Jug, ?State, ?Volume )==== holds when <var>Jug</var> (large, small or reservoir) has <var>Volume</var> in <var>State</var>. <syntaxhighlight lang="prolog"> volume( small, jugs(Small, _Large, _Reservoir), Small ). volume( large, jugs(_Small, Large, _Reservoir), Large ). volume( reservoir, jugs(_Small, _Large, Reservoir), Reservoir ). </syntaxhighlight> ====jug_permutation( ?Source, ?Target, ?Unused )==== holds when <var>Source</var>, <var>Target</var> and <var>Unused</var> are a permutation of <code>small</code>, <code>large</code> and <code>reservoir</code>. <syntaxhighlight lang="prolog"> jug_permutation( Source, Target, Unused ) :- select( Source, [small, large, reservoir], Residue ), select( Target, Residue, [Unused] ). </syntaxhighlight> ====node_state( ?Node, ?State )==== holds when the contents of the water-jugs at <var>Node</var> are described by <var>State</var>. <syntaxhighlight lang="prolog"> node_state( start(State), State ). node_state( node(_Transition, State, _Predecessor), State ). </syntaxhighlight> ==Definite Clause Grammar== ====narrative( +Solution, +Capacities, +End )/==== is a DCG presenting the water-jugs <var>Solution</var> in a readable format. The grammar is head-recursive because the <var>Solution</var> has the last node outermost. <syntaxhighlight lang="prolog"> narrative( start(Start), Capacities, End ) --> "Given three jugs with capacities of:", newline, literal_volumes( Capacities ), "To obtain the result:", newline, literal_volumes( End ), "Starting with:", newline, literal_volumes( Start ), "Do the following:", newline. narrative( node(Transition, Result, Predecessor), Capacities, End ) --> narrative( Predecessor, Capacities, End ), literal_action( Transition, Result ). literal_volumes( Volumes ) --> indent, literal( Volumes ), ";", newline. literal_action( Transition, Result ) --> indent, "- ", literal( Transition ), " giving:", newline, indent, indent, literal( Result ), newline. literal( empty_into(From,To) ) --> "Empty the ", literal( From ), " into the ", literal( To ). literal( fill_from(From,To) ) --> "Fill the ", literal( To ), " from the ", literal( From ). literal( jugs(Small,Large,Reservoir) ) --> literal_number( Small ), " gallons in the small jug, ", literal_number( Large ), " gallons in the large jug and ", literal_number( Reservoir ), " gallons in the reservoir". literal( small ) --> "small jug". literal( large ) --> "large jug". literal( reservoir ) --> "reservoir". literal_number( Number, Plus, Minus ) :- number( Number ), number_chars( Number, Chars ), append( Chars, Minus, Plus ). indent --> " ". newline --> " ". </syntaxhighlight> ==Utility Predicates== Load a small library of [[Puzzle Utilities]]. <syntaxhighlight lang="prolog"> :- ensure_loaded( misc ). </syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/download/water_jugs.txt here]. ==Output== The output of the program is: <div class="result"> <pre> ?- water_jugs. Given three jugs with capacities of: 3 gallons in the small jug, 4 gallons in the large jug and 8 gallons in the reservoir; To obtain the result: 0 gallons in the small jug, 2 gallons in the large jug and 6 gallons in the reservoir; Starting with: 0 gallons in the small jug, 0 gallons in the large jug and 8 gallons in the reservoir; Do the following: - Fill the small jug from the reservoir giving: 3 gallons in the small jug, 0 gallons in the large jug and 5 gallons in the reservoir - Empty the small jug into the large jug giving: 0 gallons in the small jug, 3 gallons in the large jug and 5 gallons in the reservoir - Fill the small jug from the reservoir giving: 3 gallons in the small jug, 3 gallons in the large jug and 2 gallons in the reservoir - Fill the large jug from the small jug giving: 2 gallons in the small jug, 4 gallons in the large jug and 2 gallons in the reservoir - Empty the large jug into the reservoir giving: 2 gallons in the small jug, 0 gallons in the large jug and 6 gallons in the reservoir - Empty the small jug into the large jug giving: 0 gallons in the small jug, 2 gallons in the large jug and 6 gallons in the reservoir yes </pre> </div> 147f30b42da6b286e858b3048b2abd14fb855a6a 0 3 105 101 2015-05-12T20:00:25Z John 2 wikitext text/x-wiki ;John Fletcher's home on the Web __NOTOC__ &ldquo;Prolog is more than a language - it is a way of living :-)&rdquo; Bart Demoen ==Prolog== Ever since I first learned Prolog, more than 20 years ago, it has been my preferred programming language. ===Why use Prolog?=== Prolog is a tool for solving problems, rather than producing &ldquo;software product&rdquo;, and it will appeal to you if: * You want your programs to be readable, and to have a close correspondence with their specifications; * Statements like x = x + 1 offend your mathematical sensibility; * You like to develop programs incrementally &ndash; with an interactive top-level, interactive debugging, and the ability to test (execute) program fragments independently; * You want fewer lines of code and therefore fewer faults; * You prefer to work with a handful of big ideas, rather than a lot of small ones; If you want to find out about Prolog on the Web, start with the [http://www.logic.at/prolog/faq/faq.html Frequently Asked Questions] for [https://groups.google.com/forum/?fromgroups#!forum/comp.lang.prolog comp.lang.prolog]. Other useful links include: * [[Logic Programming and the Internet]]. Prolog is unequalled as a language for expressing queries and integrity constraints, and for processing text, which make it an excellent choice for Internet applications. * XML documents and Prolog terms have the same &lsquo;tree&rsquo; structure, which makes it easy to program with XML and Prolog. My free code for [[Parsing XML with Prolog]] makes it even easier. * Recommended [https://binding-time.co.uk/prolog_books.html Prolog programming books]. * My solutions to some puzzles in Prolog: ** [[The Water Jugs Problem]], ** [[The Counterfeit Coin Puzzle]], ** [[Cheating Linguists]]?, ** [[Mister X]], ** [[Zoom Tracks]], ** [[Whodunit]]? Although Prolog is regarded as a niche language, it's a very versatile language. I believe that the programming languages used in 2050 will owe more to Prolog than to any other language. 7bca9b01c94570e0bb608cf5344ed63e4b0971bd 106 105 2015-05-12T20:01:22Z John 2 /* Why use Prolog? */ wikitext text/x-wiki ;John Fletcher's home on the Web __NOTOC__ &ldquo;Prolog is more than a language - it is a way of living :-)&rdquo; Bart Demoen ==Prolog== Ever since I first learned Prolog, more than 20 years ago, it has been my preferred programming language. ===Why use Prolog?=== Prolog is a tool for solving problems, rather than producing &ldquo;software products&rdquo;, and it will appeal to you if: * You want your programs to be readable, and to have a close correspondence with their specifications; * Statements like x = x + 1 offend your mathematical sensibility; * You like to develop programs incrementally &ndash; with an interactive top-level, interactive debugging, and the ability to test (execute) program fragments independently; * You want fewer lines of code and therefore fewer faults; * You prefer to work with a handful of big ideas, rather than a lot of small ones; If you want to find out about Prolog on the Web, start with the [http://www.logic.at/prolog/faq/faq.html Frequently Asked Questions] for [https://groups.google.com/forum/?fromgroups#!forum/comp.lang.prolog comp.lang.prolog]. Other useful links include: * [[Logic Programming and the Internet]]. Prolog is unequalled as a language for expressing queries and integrity constraints, and for processing text, which make it an excellent choice for Internet applications. * XML documents and Prolog terms have the same &lsquo;tree&rsquo; structure, which makes it easy to program with XML and Prolog. My free code for [[Parsing XML with Prolog]] makes it even easier. * Recommended [https://binding-time.co.uk/prolog_books.html Prolog programming books]. * My solutions to some puzzles in Prolog: ** [[The Water Jugs Problem]], ** [[The Counterfeit Coin Puzzle]], ** [[Cheating Linguists]]?, ** [[Mister X]], ** [[Zoom Tracks]], ** [[Whodunit]]? Although Prolog is regarded as a niche language, it's a very versatile language. I believe that the programming languages used in 2050 will owe more to Prolog than to any other language. 90307a15de60f6083fe6bfbe87b01847a129a187 114 106 2015-06-01T23:34:42Z John 2 wikitext text/x-wiki ;John Fletcher's home on the Web __NOTOC__ &ldquo;Prolog is more than a language - it is a way of living :-)&rdquo; Bart Demoen ==Prolog== Ever since I first learned Prolog, more than 20 years ago, it has been my preferred programming language. ===Why use Prolog?=== Prolog is a tool for solving problems, rather than producing &ldquo;software products&rdquo;, and it will appeal to you if: * You want your programs to be readable, and to have a close correspondence with their specifications; * Statements like x = x + 1 offend your mathematical sensibility; * You like to develop programs incrementally &ndash; with an interactive top-level, interactive debugging, and the ability to test (execute) program fragments independently; * You want fewer lines of code and, therefore, fewer faults; * You prefer to work with a handful of big ideas, rather than a lot of small ones; If you want to find out about Prolog on the Web, start with the [http://www.logic.at/prolog/faq/faq.html Frequently Asked Questions] for [https://groups.google.com/forum/?fromgroups#!forum/comp.lang.prolog comp.lang.prolog]. Other useful links include: * [[Logic Programming and the Internet]]. Prolog is unequaled as a language for expressing queries and integrity constraints, and for processing text, which make it an excellent choice for Internet applications. * XML documents and Prolog terms have the same &lsquo;tree&rsquo; structure, which makes it easy to program with XML and Prolog. My free code for [[Parsing XML with Prolog]] makes it even easier. * Recommended [https://binding-time.co.uk/prolog_books.html Prolog programming books]. * My solutions to some puzzles in Prolog: ** [[The Water Jugs Problem]], ** [[The Counterfeit Coin Puzzle]], ** [[Cheating Linguists]]?, ** [[Mister X]], ** [[Zoom Tracks]], ** [[Whodunit]]? Although Prolog is regarded as a niche language, it's a very versatile language. I believe that the programming languages used in 2050 will owe more to Prolog than to any other language. 51a7d8cd780dab30a55ee16c499962cd7bfb677a 116 114 2015-06-01T23:42:02Z John 2 wikitext text/x-wiki ;John Fletcher's home on the Web __NOTOC__ &ldquo;Prolog is more than a language - it is a way of living :-)&rdquo; Bart Demoen ==Prolog== Ever since I first learned Prolog, more than 20 years ago, it has been my preferred programming language. ===Why use Prolog?=== Prolog is a tool for solving problems, rather than producing &ldquo;software products&rdquo;, and it will appeal to you if: * You want your programs to be readable, and to have a close correspondence with their specifications; * Statements like x = x + 1 offend your mathematical sensibility; * You like to develop programs incrementally &ndash; with an interactive top-level, interactive debugging, and the ability to test (execute) program fragments independently; * You want fewer lines of code and, therefore, fewer faults; * You prefer to work with a handful of big ideas, rather than a lot of small ones; If you want to find out about Prolog on the Web, start with the [http://www.logic.at/prolog/faq/faq.html Frequently Asked Questions] for [https://groups.google.com/forum/?fromgroups#!forum/comp.lang.prolog comp.lang.prolog]. Other useful links include: * [[Logic Programming and the Internet]]. Prolog is unequalled as a language for expressing queries and integrity constraints, and for processing text, which make it an excellent choice for Internet applications. * XML documents and Prolog terms have the same &lsquo;tree&rsquo; structure, which makes it easy to program with XML and Prolog. My free code for [[Parsing XML with Prolog]] makes it even easier. * Recommended [https://binding-time.co.uk/prolog_books.html Prolog programming books]. * My solutions to some puzzles in Prolog: ** [[The Water Jugs Problem]], ** [[The Counterfeit Coin Puzzle]], ** [[Cheating Linguists]]?, ** [[Mister X]], ** [[Zoom Tracks]], ** [[Whodunit]]? Although Prolog is regarded as a niche language, it's a very versatile language. I believe that the programming languages used in 2050 will owe more to Prolog than to any other language. 974eb7e542d6e2655f8f1a9c543b4b79eb66bbeb 123 116 2015-07-12T17:30:11Z John 2 Changed URL for FAQ wikitext text/x-wiki ;John Fletcher's home on the Web __NOTOC__ &ldquo;Prolog is more than a language - it is a way of living :-)&rdquo; Bart Demoen ==Prolog== Ever since I first learned Prolog, more than 20 years ago, it has been my preferred programming language. ===Why use Prolog?=== Prolog is a tool for solving problems, rather than producing &ldquo;software products&rdquo;, and it will appeal to you if: * You want your programs to be readable, and to have a close correspondence with their specifications; * Statements like x = x + 1 offend your mathematical sensibility; * You like to develop programs incrementally &ndash; with an interactive top-level, interactive debugging, and the ability to test (execute) program fragments independently; * You want fewer lines of code and, therefore, fewer faults; * You prefer to work with a handful of big ideas, rather than a lot of small ones; If you want to find out about Prolog on the Web, start with the [http://www.metalevel.at/faq/faq.html Frequently Asked Questions] for [https://groups.google.com/forum/?fromgroups#!forum/comp.lang.prolog comp.lang.prolog]. Other useful links include: * [[Logic Programming and the Internet]]. Prolog is unequalled as a language for expressing queries and integrity constraints, and for processing text, which make it an excellent choice for Internet applications. * XML documents and Prolog terms have the same &lsquo;tree&rsquo; structure, which makes it easy to program with XML and Prolog. My free code for [[Parsing XML with Prolog]] makes it even easier. * Recommended [https://binding-time.co.uk/prolog_books.html Prolog programming books]. * My solutions to some puzzles in Prolog: ** [[The Water Jugs Problem]], ** [[The Counterfeit Coin Puzzle]], ** [[Cheating Linguists]]?, ** [[Mister X]], ** [[Zoom Tracks]], ** [[Whodunit]]? Although Prolog is regarded as a niche language, it's a very versatile language. I believe that the programming languages used in 2050 will owe more to Prolog than to any other language. 2f809c20c70a79a543341ffa6879a8b9cd93ff82 129 123 2015-07-30T23:14:57Z John 2 /* Why use Prolog? */ wikitext text/x-wiki ;John Fletcher's home on the Web __NOTOC__ &ldquo;Prolog is more than a language - it is a way of living :-)&rdquo; Bart Demoen ==Prolog== Ever since I first learned Prolog, more than 20 years ago, it has been my preferred programming language. ===Why use Prolog?=== Prolog is a tool for solving problems, rather than producing &ldquo;software products&rdquo;, and it will appeal to you if: * You want your programs to be readable, and to have a close correspondence with their specifications; * Statements like x = x + 1 offend your mathematical sensibility; * You like to develop programs incrementally &ndash; with an interactive top-level, interactive debugging, and the ability to test (execute) program fragments independently; * You want fewer lines of code and, therefore, fewer faults; * You prefer to work with a handful of big ideas, rather than a lot of small ones; If you want to find out about Prolog on the Web, start with the [http://www.metalevel.at/faq/faq.html Frequently Asked Questions] for [https://groups.google.com/forum/?fromgroups#!forum/comp.lang.prolog comp.lang.prolog]. Other useful links include: * [[Logic Programming and the Internet]]. Prolog is unequalled as a language for expressing queries and integrity constraints, and for processing text, which make it an excellent choice for Internet applications. * XML documents and Prolog terms have the same &lsquo;tree&rsquo; structure, which makes it easy to program with XML and Prolog. My free code for [[Parsing XML with Prolog]] makes it even easier. * Recommended [[Prolog programming books]]. * My solutions to some puzzles in Prolog: ** [[The Water Jugs Problem]], ** [[The Counterfeit Coin Puzzle]], ** [[Cheating Linguists]]?, ** [[Mister X]], ** [[Zoom Tracks]], ** [[Whodunit]]? Although Prolog is regarded as a niche language, it's a very versatile language. I believe that the programming languages used in 2050 will owe more to Prolog than to any other language. 1ec1ac3a4c76fc15509e378adc22e9ef950f8c32 133 129 2015-08-03T18:57:19Z John 2 wikitext text/x-wiki ;John Fletcher's home on the Web __NOTOC__ &ldquo;Prolog is more than a language - it is a way of living :-)&rdquo; Bart Demoen ==Prolog== Ever since I first learned Prolog, more than 30 years ago, it has been my preferred programming language. ===Why use Prolog?=== Prolog is a tool for solving problems, rather than producing &ldquo;software products&rdquo;, and it will appeal to you if: * You want your programs to be readable, and to have a close correspondence with their specifications; * Statements like x = x + 1 offend your mathematical sensibility; * You like to develop programs incrementally &ndash; with an interactive top-level, interactive debugging, and the ability to test (execute) program fragments independently; * You want fewer lines of code and, therefore, fewer faults; * You prefer to work with a handful of big ideas, rather than a lot of small ones; If you want to find out about Prolog on the Web, start with the [http://www.metalevel.at/faq/faq.html Frequently Asked Questions] for [https://groups.google.com/forum/?fromgroups#!forum/comp.lang.prolog comp.lang.prolog]. Other useful links include: * [[Logic Programming and the Internet]]. Prolog is unequalled as a language for expressing queries and integrity constraints, and for processing text, which make it an excellent choice for Internet applications. * XML documents and Prolog terms have the same &lsquo;tree&rsquo; structure, which makes it easy to program with XML and Prolog. My free code for [[Parsing XML with Prolog]] makes it even easier. * Recommended [[Prolog programming books]]. * My solutions to some puzzles in Prolog: ** [[The Water Jugs Problem]], ** [[The Counterfeit Coin Puzzle]], ** [[Cheating Linguists]]?, ** [[Mister X]], ** [[Zoom Tracks]], ** [[Whodunit]]? Although Prolog is regarded as a niche language, it's a very versatile language. I believe that the programming languages used in 2050 will owe more to Prolog than to any other language. 3bd022a85ce671e43fc3f913aad043537497cd48 143 133 2016-01-01T23:09:57Z John 2 Changed URL for FAQ wikitext text/x-wiki ;John Fletcher's home on the Web __NOTOC__ &ldquo;Prolog is more than a language - it is a way of living :-)&rdquo; Bart Demoen ==Prolog== Ever since I first learned Prolog, more than 30 years ago, it has been my preferred programming language. ===Why use Prolog?=== Prolog is a tool for solving problems, rather than producing &ldquo;software products&rdquo;, and it will appeal to you if: * You want your programs to be readable, and to have a close correspondence with their specifications; * Statements like x = x + 1 offend your mathematical sensibility; * You like to develop programs incrementally &ndash; with an interactive top-level, interactive debugging, and the ability to test (execute) program fragments independently; * You want fewer lines of code and, therefore, fewer faults; * You prefer to work with a handful of big ideas, rather than a lot of small ones; If you want to find out about Prolog on the Web, start with the [http://www.metalevel.at/prolog/faq/ Frequently Asked Questions] for [https://groups.google.com/forum/?fromgroups#!forum/comp.lang.prolog comp.lang.prolog]. Other useful links include: * [[Logic Programming and the Internet]]. Prolog is unequalled as a language for expressing queries and integrity constraints, and for processing text, which make it an excellent choice for Internet applications. * XML documents and Prolog terms have the same &lsquo;tree&rsquo; structure, which makes it easy to program with XML and Prolog. My free code for [[Parsing XML with Prolog]] makes it even easier. * Recommended [[Prolog programming books]]. * My solutions to some puzzles in Prolog: ** [[The Water Jugs Problem]], ** [[The Counterfeit Coin Puzzle]], ** [[Cheating Linguists]]?, ** [[Mister X]], ** [[Zoom Tracks]], ** [[Whodunit]]? Although Prolog is regarded as a niche language, it's a very versatile language. I believe that the programming languages used in 2050 will owe more to Prolog than to any other language. f94c554b1a3895a17459015df9f7958e219fbc3c 149 143 2016-05-03T22:43:31Z John 2 Removing a superfluous comma. wikitext text/x-wiki ;John Fletcher's home on the Web __NOTOC__ &ldquo;Prolog is more than a language - it is a way of living :-)&rdquo; Bart Demoen ==Prolog== Ever since I first learned Prolog, more than 30 years ago, it has been my preferred programming language. ===Why use Prolog?=== Prolog is a tool for solving problems, rather than producing &ldquo;software products&rdquo;, and it will appeal to you if: * You want your programs to be readable, and to have a close correspondence with their specifications; * Statements like x = x + 1 offend your mathematical sensibility; * You like to develop programs incrementally &ndash; with an interactive top-level, interactive debugging, and the ability to test (execute) program fragments independently; * You want fewer lines of code and, therefore, fewer faults; * You prefer to work with a handful of big ideas, rather than a lot of small ones; If you want to find out about Prolog on the Web, start with the [http://www.metalevel.at/prolog/faq/ Frequently Asked Questions] for [https://groups.google.com/forum/?fromgroups#!forum/comp.lang.prolog comp.lang.prolog]. Other useful links include: * [[Logic Programming and the Internet]]. Prolog is unequalled as a language for expressing queries and integrity constraints, and for processing text, which make it an excellent choice for Internet applications. * XML documents and Prolog terms have the same &lsquo;tree&rsquo; structure, which makes it easy to program with XML and Prolog. My free code for [[Parsing XML with Prolog]] makes it even easier. * Recommended [[Prolog programming books]]. * My solutions to some puzzles in Prolog: ** [[The Water Jugs Problem]], ** [[The Counterfeit Coin Puzzle]], ** [[Cheating Linguists]]? ** [[Mister X]], ** [[Zoom Tracks]], ** [[Whodunit]]? Although Prolog is regarded as a niche language, it's a very versatile language. I believe that the programming languages used in 2050 will owe more to Prolog than to any other language. 66d6ea0120ace722b7a41f58d27e81ef46ebf447 150 149 2016-05-08T20:11:18Z John 2 /* Why use Prolog? */ wikitext text/x-wiki ;John Fletcher's home on the Web __NOTOC__ &ldquo;Prolog is more than a language - it is a way of living :-)&rdquo; Bart Demoen ==Prolog== Ever since I first learned Prolog, more than 30 years ago, it has been my preferred programming language. ===Why use Prolog?=== Prolog is a tool for solving problems, rather than producing &ldquo;software products&rdquo;, and it will appeal to you if: * You want your programs to be readable, and to have a close correspondence with their specifications; * Statements like x = x + 1 offend your mathematical sensibility; * You like to develop programs incrementally &ndash; with an interactive top-level, interactive debugging, and the ability to test (execute) program fragments independently; * You want fewer lines of code and, therefore, fewer faults; * You prefer to work with a handful of big ideas, rather than a lot of small ones; If you want to find out about Prolog on the Web, start with the [https://www.metalevel.at/prolog/faq/ Frequently Asked Questions] for [https://groups.google.com/forum/?fromgroups#!forum/comp.lang.prolog comp.lang.prolog]. Other useful links include: * [[Logic Programming and the Internet]]. Prolog is unequalled as a language for expressing queries and integrity constraints, and for processing text, which make it an excellent choice for Internet applications. * XML documents and Prolog terms have the same &lsquo;tree&rsquo; structure, which makes it easy to program with XML and Prolog. My free code for [[Parsing XML with Prolog]] makes it even easier. * Recommended [[Prolog programming books]]. * My solutions to some puzzles in Prolog: ** [[The Water Jugs Problem]], ** [[The Counterfeit Coin Puzzle]], ** [[Cheating Linguists]]? ** [[Mister X]], ** [[Zoom Tracks]], ** [[Whodunit]]? Although Prolog is regarded as a niche language, it's a very versatile language. I believe that the programming languages used in 2050 will owe more to Prolog than to any other language. 769e2f9280d0dfeed7f41902760140d34829c240 0 2 107 93 2015-05-12T21:08:52Z John 2 wikitext text/x-wiki __NOTOC__ ==Problem Definition== We are given 12 apparently identical coins - one of which is counterfeit. We know that the counterfeit has a different weight from the others, but we don't know if it's heavier or lighter. ===Task:=== Devise a procedure to identify any counterfeit coin using a balance to take up to three comparative weighings. ==Strategy== The information from three suitable weighings will make all but one of the coins, which are untested initially, known_true. There are three alternative deductions that make a coin known_true: * if it is not_heavy and not_light &ndash; having been on both the comparatively lighter and heavier sides of imbalances; * if it was excluded from an imbalance; * if it was included in a balanced weighing. After three weighings there must be exactly one coin, the counterfeit, which is not known_true. If the counterfeit is not known_true and not_heavy we deduce that it must be light. If it is not known_true and not_light, it must be heavy. We use a generate-and-test method as follows: * Create the set of all possible counterfeits: 12 coins &times; 2 weights ; * Devise a procedure that can identify the first counterfeit coin; * Show that the same procedure works for every other counterfeit coin. ==Entry Point== ====go==== is the entry point. It solves the puzzle, then uses a DCG to pretty-print the resulting procedure. <syntaxhighlight lang="prolog"> go :- coins_puzzle( Procedure ), phrase( general_explanation( Procedure ), Chars ), put_chars( Chars ). </syntaxhighlight> ====coins_puzzle( ?Procedure )==== generates the set of all possible counterfeit coins and finds, or proves, that <var>Procedure</var> can identify them all. <syntaxhighlight lang="prolog"> coins_puzzle( Procedure ) :- coins( Coins ), counterfeit( Counterfeit, Coin, Weight ), findall( Counterfeit, (member(Coin,Coins), counterfeit_weight(Weight)), Counterfeits ), coins_puzzle_solution( Counterfeits, Procedure ). coins_puzzle_solution( [], _Procedure ). coins_puzzle_solution( [Counterfeit|Counterfeits], Procedure ) :- solve_coins( Counterfeit, Procedure ), coins_puzzle_solution( Counterfeits, Procedure ). </syntaxhighlight> A procedure is either &lsquo;done&rsquo;, identifying a particular coin and whether it is heavy or light; or it is a &lsquo;step&rsquo;. A step defines the coins to be placed on the <var>Left</var> and <var>Right</var> pans, with the residue remaining on the <var>Table</var>, and three <var>Branches</var>, one of which will be chosen depending on the outcome of the weighing. <syntaxhighlight lang="prolog"> step( step(Left,Right,Table,Branches), Left, Right, Table, Branches). </syntaxhighlight> The <var>Branches</var> are three procedures equating to: * > (left pan heavier), * < (right pan heavier) and * <nowiki>= (pans balance).</nowiki> <syntaxhighlight lang="prolog"> branch( >, branches(_Equal, GT, _LT), GT ). branch( <, branches(_Equal, _GT, LT), LT ). branch( =, branches(Equal, _GT, _LT), Equal ). </syntaxhighlight> The counterfeit is defined by its number and whether it is heavy or light. <syntaxhighlight lang="prolog"> counterfeit( counterfeit(Coin, HeavyOrLight), Coin, HeavyOrLight ). coins( [1,2,3,4,5,6,7,8,9,10,11,12] ). counterfeit_weight( heavy ). counterfeit_weight( light ). </syntaxhighlight> A &lsquo;coin collection&rsquo; comprises four &lsquo;parts&rsquo; (subsets): the <code>known_true</code>, <code>not_heavy</code>, <code>not_light</code> and <code>untested</code> sets of coins. <syntaxhighlight lang="prolog"> part( known_true, collection(Coins,_,_,_), Coins ). part( not_heavy, collection(_,Coins,_,_), Coins ). part( not_light, collection(_,_,Coins,_), Coins ). part( untested, collection(_,_,_,Coins), Coins ). </syntaxhighlight> ==Solution== ====solve_coins( +Counterfeit, ?Procedure )==== holds when <var>Procedure</var> can correctly identify the <var>Counterfeit</var> coin. Beginning with a &lsquo;start&rsquo; collection, in which all the coins are untested, the <var>Procedure</var> comprises three &lsquo;steps&rsquo;. For each step, a weighing is made and a &lsquo;branch&rsquo; is made in the <var>Procedure</var>, depending on the result of the weighing. After three steps, the <var>Procedure</var> must have reached the &lsquo;end&rsquo; condition. Finally, an assertion (redundant test) ensures that the <var>Procedure</var> has found the correct end condition. <syntaxhighlight lang="prolog"> solve_coins( Counterfeit, Procedure ) :- start( Coins0 ), assay( Counterfeit, Coins0, Procedure, Branch1, Coins1 ), assay( Counterfeit, Coins1, Branch1, Branch2, Coins2 ), assay( Counterfeit, Coins2, Branch2, done(Coin, HeavyOrLight), Coins3 ), end( Coins3, Coin, HeavyOrLight ), counterfeit( Counterfeit, Coin, HeavyOrLight ). start( Coins ) :- coins( Untested ), part( untested, Coins, Untested ), part( not_heavy, Coins, [] ), part( not_light, Coins, [] ), part( known_true, Coins, [] ). end( Coins, Coin, HeavyOrLight ) :- part( untested, Coins, [] ), part( not_heavy, Coins, Light ), part( not_light, Coins, Heavy ), end_result( Heavy, Light, Coin, HeavyOrLight ). end_result( [Coin], [], Coin, heavy ). end_result( [], [Coin], Coin, light ). </syntaxhighlight> === Simulating the weighing process === ====assay( +Counterfeit, +Coins0, ?Step, ?Branch, ?Coins1 )==== holds when the appropriate <var>Branch</var> from <var>Step</var> is chosen by comparing the weights of two coin collections taken from the full set of coins: <var>Coins0</var>. <var>Coins1</var> is the full set of coins, updated with the inferences drawn from the weighing. <var>Counterfeit</var> is used to determine the result of the weighing. This predicate applies the critical insight into the solution of this puzzle: we have 24 (12 &times; 2) possible inputs to the procedure, with only 27 (3 &times; 3 &times; 3) possible outcomes from the weighings. Therefore, it is clear that each weighing must have a very high [[#Information Content|information content]]. Choosing which weighing to make by estimating the available information content makes the problem tractable. <syntaxhighlight lang="prolog"> assay( Counterfeit, Coins0, Step, Branch, Coins ) :- WeighingDatum = weighing_data(InfoContent, Left, Right, Table), step( Step, Left, Right, Table, Branches ), findall( WeighingDatum, valid_partition( Coins0, InfoContent, Left, Right, Table ), WeighingData ), sort( WeighingData, OrderedWeighingData ), member( WeighingDatum, OrderedWeighingData ), balance( Left, Right, Counterfeit, Result ), draw_inferences( Result, Left, Right, Table, Coins ), branch( Result, Branches, Branch ). </syntaxhighlight> ====balance( +Left, +Right, +Counterfeit, ?Result )==== holds when <var>Result</var> simulates the outcome of testing the coin collections <var>Left</var> and <var>Right</var> with a balance, where either may contain the <var>Counterfeit</var> coin. <syntaxhighlight lang="prolog"> balance( Left, Right, Counterfeit, Result ):- counterfeit( Counterfeit, Coin, Weight ), ( contains_coin( Left, Coin ) -> balance_result( Weight, normal, Result ) ; contains_coin( Right, Coin ) -> balance_result( normal, Weight, Result ) ; otherwise -> Result = '=' ). balance_result( light, normal, < ). balance_result( heavy, normal, > ). balance_result( normal, heavy, < ). balance_result( normal, light, > ). </syntaxhighlight> ===Choosing which coins to weigh=== ====valid_partition( +Coins, ?Content, ?Left, ?Right, ?Table )==== holds when <var>Coins</var> can be partitioned into three collections: <var>Left</var> side, <var>Right</var> side and <var>Table</var>; with the information content of the partition given by <var>Content</var>. The definition of a valid_partition ensures that: * <var>Left</var> and <var>Right</var> must have the same number of coins (at least one); * <var>Left</var> cannot contain any known_true coins, because adding true coins to both sides creates redundant comparisons. A &lsquo;checksum&rsquo; is used to ensure that only one member of each pair of symmetrical solutions can be generated. <syntaxhighlight lang="prolog"> valid_partition( Coins, Content, Left, Right, Table ):- part( known_true, Left, [] ), selection( Coins, Left, Coins1, Count, LeftChecksum, LeftInfo ), Count >= 1, selection( Coins1, Right, Table, Count, RightChecksum, RightInfo ), LeftChecksum =< RightChecksum, % Checksum to prevent symmetrical solutions table_information( Table, TableInfo ), sum( [LeftInfo,RightInfo,TableInfo], Content ). </syntaxhighlight> ====selection( +Coins, ?Sample, ?Residue, ?Count, ?Checksum, ?Content )==== holds when <var>Coins</var> is partitioned into two collections: <var>Sample</var> and <var>Residue</var>. <var>Count</var> is the number of coins in <var>Sample</var>. <var>Checksum</var> is a fingerprint for the mixture of coins in <var>Sample</var>, which has estimated information <var>Content</var>. <syntaxhighlight lang="prolog"> selection( Coins, Sample, Residue, Count, Checksum, Content ) :- select_coins( not_heavy, Coins, Sample, Residue, Count1 ), select_coins( not_light, Coins, Sample, Residue, Count2 ), select_coins( untested, Coins, Sample, Residue, Count3 ), select_coins( known_true, Coins, Sample, Residue, Count4 ), Count is Count1+Count2+Count3+Count4, Count =< 6, Checksum is Count1+(7*Count2)+(43*Count3)+(259*Count4), information_content( [Count1,Count2,Count3,Count4], Content ). </syntaxhighlight> ====table_information( +Coins, ?Content )==== holds when <var>Coins</var> has 'information content' <var>Content</var>. <syntaxhighlight lang="prolog"> table_information( Coins, Content ) :- count_coins( not_heavy, Coins, Count1 ), count_coins( not_light, Coins, Count2 ), count_coins( untested, Coins, Count3 ), count_coins( known_true, Coins, Count4 ), information_content( [Count1,Count2,Count3,Count4], Content ). count_coins( Part, Coins, Count ) :- part( Part, Coins, Selection ), length( Selection, Count ). </syntaxhighlight> === Updating what is known about the coins === ====draw_inferences( +Result, +Left, +Right, +Table, ?Coins )==== holds when <var>Result</var> is one of: * > (imbalance &ndash; left pan heavier), * < (imbalance &ndash; right pan heavier) or * <nowiki>=</nowiki> (pans balanced) from taking a weighing with the coin collections: <var>Left</var>, <var>Right</var> and <var>Table</var>. <var>Coins</var> is derived from this information using the following rules: * If the pans are unbalanced then only the previously untested or not_heavy coins on the lighter side of the balance are now not_heavy. Similarly, only the previously untested or not_light coins on the heavier side of the balance are now not_light. All the coins on the table are now known_true. * If the pans balance then all the coins weighed are known_true, with the coins on the <var>Table</var> left in their prior states. <syntaxhighlight lang="prolog"> draw_inferences( <, Left, Right, Table, Coins ) :- imbalance_inferences( Left, Right, Table, Coins ). draw_inferences( >, Left, Right, Table, Coins ) :- imbalance_inferences( Right, Left, Table, Coins ). draw_inferences( =, Left, Right, Table, Coins ) :- becomes( [all(Left),known_true(Table),all(Right)], known_true( Coins ) ), becomes( untested(Table), untested(Coins) ), becomes( not_heavy(Table), not_heavy(Coins) ), becomes( not_light(Table), not_light(Coins) ). </syntaxhighlight> ====imbalance_inferences( +Lighter, +Heavier, +Table, ?Coins )==== holds when: * Only the untested or not_heavy coins in <var>Lighter</var> are not_heavy in <var>Coins</var>; * Only the untested or not_light coins in <var>Heavier</var> are not_light in <var>Coins</var>; * All the other coins in <var>Lighter</var> and <var>Heavier</var> and all the coins in <var>Table</var> are known_true in <var>Coins</var>; There are no untested coins in <var>Coins</var>. <syntaxhighlight lang="prolog"> imbalance_inferences( Lighter, Heavier, Table, Coins ) :- becomes( [untested(Lighter),not_heavy(Lighter)], not_heavy(Coins) ), becomes( [untested(Heavier),not_light(Heavier)], not_light(Coins) ), becomes( [ known_true(Lighter), not_light(Lighter), known_true(Heavier), not_heavy(Heavier), all(Table) ], known_true(Coins) ), part( untested, Coins, [] ). </syntaxhighlight> ====becomes( +CollectionA, ?CollectionB )==== <var>CollectionA</var> becomes (part) <var>CollectionB</var> when <var>CollectionB</var> comprises the same coins as <var>CollectionA</var>. <syntaxhighlight lang="prolog"> becomes( CollectionA, CollectionB ) :- unfolded( CollectionA, Coins ), unfolded( CollectionB, Coins ). </syntaxhighlight> ====unfolded( +Collection, ?Coins )==== holds when (part) <var>Collection</var> comprises <var>Coins</var>. <syntaxhighlight lang="prolog"> unfolded( not_light(Collection), Coins ) :- part( not_light, Collection, Coins ). unfolded( not_heavy(Collection), Coins ) :- part( not_heavy, Collection, Coins ). unfolded( known_true(Collection), Coins ) :- part( known_true, Collection, Coins ). unfolded( untested(Collection), Coins ) :- part( untested, Collection, Coins ). unfolded( all(Collection), Coins ) :- collection_to_set( Collection, Coins ). unfolded( [Item|Items], Coins ) :- unfolded( Item, Value ), unfolded1( Items, Value, Coins ). unfolded1( [], Coins, Coins ). unfolded1( [Item|Items], Value, Coins ) :- unfolded( Item, Value0 ), ord_union( Value0, Value, Value1 ), unfolded1( Items, Value1, Coins ). </syntaxhighlight> ==Definite Clause Grammar== The following DCG represents the method for finding the counterfeit coin as a structured procedure. <syntaxhighlight lang="prolog"> general_explanation( Procedure ) --> "Number the coins 1..12", newline, explanation( Procedure, 0 ). explanation( done(Coin, Weight), N ) --> tab( N ), "Conclude that the counterfeit coin is number ", literal( Coin ), ", which is ", literal( Weight ), newline. explanation( Step, N ) --> {step( Step, Left, Right, Table, Branches )}, tab( N ), "BEGIN", newline, tab( N ), "Put ", literal( Left ), " on the left-hand pan", newline, tab( N ), "Put ", literal( Right ), " on the right-hand pan", newline, tab( N ), "Leaving ", literal( Table ), " on the table", newline, branches_explained( Branches, N ), tab( N ), "END", newline. branches_explained( Branches, N ) --> next_step_explained( <, Branches, N ), next_step_explained( >, Branches, N ), next_step_explained( =, Branches, N ). next_step_explained( Result, Branch, N ) --> {branch( Result, Branch, Step )}, ( {var(Step)} -> "" | {nonvar(Step)} -> tab( N ), "If the ", literal( Result ), " then:", newline, explanation( Step, s(N) ) ). literal( 0 ) --> "0". literal( 1 ) --> "1". literal( 2 ) --> "2". literal( 3 ) --> "3". literal( 4 ) --> "4". literal( 5 ) --> "5". literal( 6 ) --> "6". literal( 7 ) --> "7". literal( 8 ) --> "8". literal( 9 ) --> "9". literal( 10 ) --> "10". literal( 11 ) --> "11". literal( 12 ) --> "12". literal( true ) --> "true". literal( heavy ) --> "heavy". literal( light ) --> "light". literal( = ) --> "pans balance". literal( < ) --> "right-hand pan is heavier". literal( > ) --> "left-hand pan is heavier". literal( Collection ) --> {collection_to_set( Collection , [H|T] )}, literal_set( T, H ). literal_set( [], Number ) --> "the coin numbered ", literal( Number ). literal_set( [H|T], Number ) --> "the coins numbered ", literal( Number ), literal_set1( T, H ). literal_set1( [], Number ) --> " and ", literal( Number ). literal_set1( [H|T], Number ) --> ", ", literal( Number ), literal_set1( T, H ). tab( 0 ) --> "". tab( s(N) ) --> " ", tab( N ). newline --> " ". </syntaxhighlight> ===Utility Predicates=== ====contains_coin( ?Collection, ?Coin )==== holds when <var>Coin</var> is a member of <var>Collection</var>. <syntaxhighlight lang="prolog"> contains_coin( Collection, Coin ) :- part( _Part, Collection, Coins ), member( Coin, Coins ). </syntaxhighlight> ====collection_to_set( +Collection, ?Set )==== holds when <var>Set</var> is the distributed union of the <code>known_true</code>, <code>not_heavy</code>, <code>not_light</code> and <code>untested</code> ordsets comprising <var>Collection</var>. <syntaxhighlight lang="prolog"> collection_to_set( Collection, Set ) :- part( known_true, Collection, KnownTrue ), part( not_heavy, Collection, NotHeavy ), part( not_light, Collection, NotLight ), part( untested, Collection, Untested ), ord_union( [KnownTrue,NotHeavy,NotLight,Untested], Set ). </syntaxhighlight> ===Information Content=== ==== information_content( +Counts, ?Content ) ==== holds when <var>Content</var> is the cumulative negative entropy of <var>Counts</var>. A reduction in entropy equates to a gain in information. <syntaxhighlight lang="prolog"> information_content( Counts, Content ) :- information_content1( Counts, 0, Content ). information_content1( [], Content, Content ). information_content1( [Count|Counts], Content0, Content ):- coins_entropy( Count, Entropy ), Content1 is Content0-Entropy, information_content1( Counts, Content1, Content ). </syntaxhighlight> ==== coins_entropy( ?N, ?Entropy ) ==== holds when <var>Entropy</var> estimates the entropy of a sample of <var>N</var> coins. <var>Entropy</var> = P log₂(¹&frasl;_P), where P = <var>N</var>&divide;12. <syntaxhighlight lang="prolog"> coins_entropy( 0, 0.0 ). coins_entropy( 1, 0.2987 ). coins_entropy( 2, 0.4308 ). coins_entropy( 3, 0.5 ). coins_entropy( 4, 0.5283 ). coins_entropy( 5, 0.5263 ). coins_entropy( 6, 0.5 ). coins_entropy( 7, 0.4536 ). coins_entropy( 8, 0.39 ). coins_entropy( 9, 0.3113 ). coins_entropy( 10, 0.2192 ). coins_entropy( 11, 0.1151 ). coins_entropy( 12, 0.0 ). </syntaxhighlight> ====select_coins( +Part, +Coins, ?Sample, ?Residue, ?N )==== holds when <var>N</var> coins from <var>Part</var> of <var>Coins</var> form <var>Part</var> of <var>Sample</var>, with the remainder forming <var>Part</var> of <var>Residue</var>. <syntaxhighlight lang="prolog"> select_coins( Part, Coins, Sample, Residue, Count ) :- part( Part, Coins, Input ), part( Part, Sample, Selection ), part( Part, Residue, Remainder ), select_n( Count, Input, Selection, Remainder ). select_n( 0, In, [], In ). select_n( 1, [A|Suffix], [A], Suffix ). select_n( 2, [A,B|Suffix], [A,B], Suffix ). select_n( 3, [A,B,C|Suffix], [A,B,C], Suffix ). select_n( 4, [A,B,C,D|Suffix], [A,B,C,D], Suffix ). select_n( 5, [A,B,C,D,E|Suffix], [A,B,C,D,E], Suffix ). select_n( 6, [A,B,C,D,E,F|Suffix], [A,B,C,D,E,F], Suffix ). </syntaxhighlight> Load a small library of [[Puzzle Utilities]]. <syntaxhighlight lang="prolog"> :- ensure_loaded( misc ). </syntaxhighlight> Use the ordsets library. <syntaxhighlight lang="prolog"> :- use_module( library(ordsets), [ord_union/2,ord_union/3] ). </syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/download/counterfeit.txt here]. ==Output== <div class="result"> Number the coins 1..12 BEGIN Put the coins numbered 1, 2, 3 and 4 on the left-hand pan Put the coins numbered 5, 6, 7 and 8 on the right-hand pan Leaving the coins numbered 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 1, 2, 5 and 6 on the left-hand pan Put the coins numbered 3, 7, 9 and 10 on the right-hand pan Leaving the coins numbered 4, 8, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 1 and 7 on the left-hand pan Put the coins numbered 3 and 4 on the right-hand pan Leaving the coins numbered 2, 5, 6, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 1, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 7, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 2, which is light END If the left-hand pan is heavier then: BEGIN Put the coins numbered 3 and 5 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 4, 6, 7, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 3, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 5, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 6, which is heavy END If the pans balance then: BEGIN Put the coins numbered 4 and 8 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 3, 5, 6, 7, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 4, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 8, which is heavy END END If the left-hand pan is heavier then: BEGIN Put the coins numbered 1, 2, 5 and 6 on the left-hand pan Put the coins numbered 3, 7, 9 and 10 on the right-hand pan Leaving the coins numbered 4, 8, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 3 and 5 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 4, 6, 7, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 5, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 3, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 6, which is light END If the left-hand pan is heavier then: BEGIN Put the coins numbered 1 and 7 on the left-hand pan Put the coins numbered 3 and 4 on the right-hand pan Leaving the coins numbered 2, 5, 6, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 7, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 1, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 2, which is heavy END If the pans balance then: BEGIN Put the coins numbered 4 and 8 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 3, 5, 6, 7, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 8, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 4, which is heavy END END If the pans balance then: BEGIN Put the coins numbered 9, 10 and 11 on the left-hand pan Put the coins numbered 1, 2 and 3 on the right-hand pan Leaving the coins numbered 4, 5, 6, 7, 8 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coin numbered 9 on the left-hand pan Put the coin numbered 10 on the right-hand pan Leaving the coins numbered 1, 2, 3, 4, 5, 6, 7, 8, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 9, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 10, which is light If the pans balance then: Conclude that the counterfeit coin is number 11, which is light END If the left-hand pan is heavier then: BEGIN Put the coin numbered 9 on the left-hand pan Put the coin numbered 10 on the right-hand pan Leaving the coins numbered 1, 2, 3, 4, 5, 6, 7, 8, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 10, which is heavy If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 9, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 11, which is heavy END If the pans balance then: BEGIN Put the coin numbered 12 on the left-hand pan Put the coin numbered 1 on the right-hand pan Leaving the coins numbered 2, 3, 4, 5, 6, 7, 8, 9, 10 and 11 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 12, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 12, which is heavy END END END </div> ---- b16c5d7eea02fc9495e0e5fcc8c30c5a40c142f8 136 107 2015-10-24T16:25:25Z John 2 Replace checksum with direct comparison of the coins mixtures. wikitext text/x-wiki __NOTOC__ ==Problem Definition== We are given 12 apparently identical coins - one of which is counterfeit. We know that the counterfeit has a different weight from the others, but we don't know if it's heavier or lighter. ===Task:=== Devise a procedure to identify any counterfeit coin using a balance to take up to three comparative weighings. ==Strategy== The information from three suitable weighings will make all but one of the coins, which are untested initially, known_true. There are three alternative deductions that make a coin known_true: * if it is not_heavy and not_light &ndash; having been on both the comparatively lighter and heavier sides of imbalances; * if it was excluded from an imbalance; * if it was included in a balanced weighing. After three weighings there must be exactly one coin, the counterfeit, which is not known_true. If the counterfeit is not known_true and not_heavy we deduce that it must be light. If it is not known_true and not_light, it must be heavy. We use a generate-and-test method as follows: * Create the set of all possible counterfeits: 12 coins &times; 2 weights ; * Devise a procedure that can identify the first counterfeit coin; * Show that the same procedure works for every other counterfeit coin. ==Entry Point== ====go==== is the entry point. It solves the puzzle, then uses a DCG to pretty-print the resulting procedure. <syntaxhighlight lang="prolog"> go :- coins_puzzle( Procedure ), phrase( general_explanation( Procedure ), Chars ), put_chars( Chars ). </syntaxhighlight> ====coins_puzzle( ?Procedure )==== generates the set of all possible counterfeit coins and finds, or proves, that <var>Procedure</var> can identify them all. <syntaxhighlight lang="prolog"> coins_puzzle( Procedure ) :- coins( Coins ), counterfeit( Counterfeit, Coin, Weight ), findall( Counterfeit, (member(Coin,Coins), counterfeit_weight(Weight)), Counterfeits ), coins_puzzle_solution( Counterfeits, Procedure ). coins_puzzle_solution( [], _Procedure ). coins_puzzle_solution( [Counterfeit|Counterfeits], Procedure ) :- solve_coins( Counterfeit, Procedure ), coins_puzzle_solution( Counterfeits, Procedure ). </syntaxhighlight> A procedure is either &lsquo;done&rsquo;, identifying a particular coin and whether it is heavy or light; or it is a &lsquo;step&rsquo;. A step defines the coins to be placed on the <var>Left</var> and <var>Right</var> pans, with the residue remaining on the <var>Table</var>, and three <var>Branches</var>, one of which will be chosen depending on the outcome of the weighing. <syntaxhighlight lang="prolog"> step( step(Left,Right,Table,Branches), Left, Right, Table, Branches). </syntaxhighlight> The <var>Branches</var> are three procedures equating to: * > (left pan heavier), * < (right pan heavier) and * <nowiki>= (pans balance).</nowiki> <syntaxhighlight lang="prolog"> branch( >, branches(_Equal, GT, _LT), GT ). branch( <, branches(_Equal, _GT, LT), LT ). branch( =, branches(Equal, _GT, _LT), Equal ). </syntaxhighlight> The counterfeit is defined by its number and whether it is heavy or light. <syntaxhighlight lang="prolog"> counterfeit( counterfeit(Coin, HeavyOrLight), Coin, HeavyOrLight ). coins( [1,2,3,4,5,6,7,8,9,10,11,12] ). counterfeit_weight( heavy ). counterfeit_weight( light ). </syntaxhighlight> A &lsquo;coin collection&rsquo; comprises four &lsquo;parts&rsquo; (subsets): the <code>known_true</code>, <code>not_heavy</code>, <code>not_light</code> and <code>untested</code> sets of coins. <syntaxhighlight lang="prolog"> part( known_true, collection(Coins,_,_,_), Coins ). part( not_heavy, collection(_,Coins,_,_), Coins ). part( not_light, collection(_,_,Coins,_), Coins ). part( untested, collection(_,_,_,Coins), Coins ). </syntaxhighlight> ==Solution== ====solve_coins( +Counterfeit, ?Procedure )==== holds when <var>Procedure</var> can correctly identify the <var>Counterfeit</var> coin. Beginning with a &lsquo;start&rsquo; collection, in which all the coins are untested, the <var>Procedure</var> comprises three &lsquo;steps&rsquo;. For each step, a weighing is made and a &lsquo;branch&rsquo; is made in the <var>Procedure</var>, depending on the result of the weighing. After three steps, the <var>Procedure</var> must have reached the &lsquo;end&rsquo; condition. Finally, an assertion (redundant test) ensures that the <var>Procedure</var> has found the correct end condition. <syntaxhighlight lang="prolog"> solve_coins( Counterfeit, Procedure ) :- start( Coins0 ), assay( Counterfeit, Coins0, Procedure, Branch1, Coins1 ), assay( Counterfeit, Coins1, Branch1, Branch2, Coins2 ), assay( Counterfeit, Coins2, Branch2, done(Coin, HeavyOrLight), Coins3 ), end( Coins3, Coin, HeavyOrLight ), counterfeit( Counterfeit, Coin, HeavyOrLight ). start( Coins ) :- coins( Untested ), part( untested, Coins, Untested ), part( not_heavy, Coins, [] ), part( not_light, Coins, [] ), part( known_true, Coins, [] ). end( Coins, Coin, HeavyOrLight ) :- part( untested, Coins, [] ), part( not_heavy, Coins, Light ), part( not_light, Coins, Heavy ), end_result( Heavy, Light, Coin, HeavyOrLight ). end_result( [Coin], [], Coin, heavy ). end_result( [], [Coin], Coin, light ). </syntaxhighlight> === Simulating the weighing process === ====assay( +Counterfeit, +Coins0, ?Step, ?Branch, ?Coins1 )==== holds when the appropriate <var>Branch</var> from <var>Step</var> is chosen by comparing the weights of two coin collections taken from the full set of coins: <var>Coins0</var>. <var>Coins1</var> is the full set of coins, updated with the inferences drawn from the weighing. <var>Counterfeit</var> is used to determine the result of the weighing. This predicate applies the critical insight into the solution of this puzzle: we have 24 (12 &times; 2) possible inputs to the procedure, with only 27 (3 &times; 3 &times; 3) possible outcomes from the weighings. Therefore, it is clear that each weighing must have a very high [[#Information Content|information content]]. Choosing which weighing to make by estimating the available information content makes the problem tractable. <syntaxhighlight lang="prolog"> assay( Counterfeit, Coins0, Step, Branch, Coins ) :- WeighingDatum = weighing_data(InfoContent, Left, Right, Table), step( Step, Left, Right, Table, Branches ), findall( WeighingDatum, valid_partition( Coins0, InfoContent, Left, Right, Table ), WeighingData ), sort( WeighingData, OrderedWeighingData ), member( WeighingDatum, OrderedWeighingData ), balance( Left, Right, Counterfeit, Result ), draw_inferences( Result, Left, Right, Table, Coins ), branch( Result, Branches, Branch ). </syntaxhighlight> ====balance( +Left, +Right, +Counterfeit, ?Result )==== holds when <var>Result</var> simulates the outcome of testing the coin collections <var>Left</var> and <var>Right</var> with a balance, where either may contain the <var>Counterfeit</var> coin. <syntaxhighlight lang="prolog"> balance( Left, Right, Counterfeit, Result ):- counterfeit( Counterfeit, Coin, Weight ), ( contains_coin( Left, Coin ) -> balance_result( Weight, normal, Result ) ; contains_coin( Right, Coin ) -> balance_result( normal, Weight, Result ) ; otherwise -> Result = '=' ). balance_result( light, normal, < ). balance_result( heavy, normal, > ). balance_result( normal, heavy, < ). balance_result( normal, light, > ). </syntaxhighlight> ===Choosing which coins to weigh=== ====valid_partition( +Coins, ?Content, ?Left, ?Right, ?Table )==== holds when <var>Coins</var> can be partitioned into three collections: <var>Left</var> side, <var>Right</var> side and <var>Table</var>; with the information content of the partition given by <var>Content</var>. The definition of a valid_partition ensures that: * <var>Left</var> and <var>Right</var> must have the same number of coins (at least one); * <var>Left</var> cannot contain any known_true coins, because adding true coins to both sides creates redundant comparisons; * Symmetry is broken for comparisons between mixtures of coins. <syntaxhighlight lang="prolog"> valid_partition( Coins, Content, Left, Right, Table ):- part( known_true, Left, [] ), selection( Coins, Left, Coins1, LeftCount, LeftInfo ), selection( Coins1, Right, Table, RightCount, RightInfo ), LeftCount =:= RightCount, LeftCount @>= RightCount, table_information( Table, TableInfo ), sum( [LeftInfo,RightInfo,TableInfo], Content ). </syntaxhighlight> ====selection( +Coins, ?Sample, ?Residue, ?Count, ?Content )==== holds when <var>Coins</var> is partitioned into two collections: <var>Sample</var> and <var>Residue</var>. <var>Count</var> is a sum used as both a fingerprint for the mixture of coins in <var>Sample</var> and a representation of the number of coins in <var>Sample</var>. <var>Content</var> estimates the information-content of <var>Sample</var>. <syntaxhighlight lang="prolog"> selection( Coins, Sample, Residue, Count, Content ) :- Count = Count1+Count2+Count3+Count4, select_coins( not_heavy, Coins, Sample, Residue, Count1 ), select_coins( not_light, Coins, Sample, Residue, Count2 ), select_coins( untested, Coins, Sample, Residue, Count3 ), select_coins( known_true, Coins, Sample, Residue, Count4 ), Count >= 1, Count =< 6, information_content( [Count1,Count2,Count3,Count4], Content ). </syntaxhighlight> ====table_information( +Coins, ?Content )==== holds when <var>Coins</var> has 'information content' <var>Content</var>. <syntaxhighlight lang="prolog"> table_information( Coins, Content ) :- count_coins( not_heavy, Coins, Count1 ), count_coins( not_light, Coins, Count2 ), count_coins( untested, Coins, Count3 ), count_coins( known_true, Coins, Count4 ), information_content( [Count1,Count2,Count3,Count4], Content ). count_coins( Part, Coins, Count ) :- part( Part, Coins, Selection ), length( Selection, Count ). </syntaxhighlight> === Updating what is known about the coins === ====draw_inferences( +Result, +Left, +Right, +Table, ?Coins )==== holds when <var>Result</var> is one of: * > (imbalance &ndash; left pan heavier), * < (imbalance &ndash; right pan heavier) or * <nowiki>=</nowiki> (pans balanced) from taking a weighing with the coin collections: <var>Left</var>, <var>Right</var> and <var>Table</var>. <var>Coins</var> is derived from this information using the following rules: * If the pans are unbalanced then only the previously untested or not_heavy coins on the lighter side of the balance are now not_heavy. Similarly, only the previously untested or not_light coins on the heavier side of the balance are now not_light. All the coins on the table are now known_true. * If the pans balance then all the coins weighed are known_true, with the coins on the <var>Table</var> left in their prior states. <syntaxhighlight lang="prolog"> draw_inferences( <, Left, Right, Table, Coins ) :- imbalance_inferences( Left, Right, Table, Coins ). draw_inferences( >, Left, Right, Table, Coins ) :- imbalance_inferences( Right, Left, Table, Coins ). draw_inferences( =, Left, Right, Table, Coins ) :- becomes( [all(Left),known_true(Table),all(Right)], known_true( Coins ) ), becomes( untested(Table), untested(Coins) ), becomes( not_heavy(Table), not_heavy(Coins) ), becomes( not_light(Table), not_light(Coins) ). </syntaxhighlight> ====imbalance_inferences( +Lighter, +Heavier, +Table, ?Coins )==== holds when: * Only the untested or not_heavy coins in <var>Lighter</var> are not_heavy in <var>Coins</var>; * Only the untested or not_light coins in <var>Heavier</var> are not_light in <var>Coins</var>; * All the other coins in <var>Lighter</var> and <var>Heavier</var> and all the coins in <var>Table</var> are known_true in <var>Coins</var>; There are no untested coins in <var>Coins</var>. <syntaxhighlight lang="prolog"> imbalance_inferences( Lighter, Heavier, Table, Coins ) :- becomes( [untested(Lighter),not_heavy(Lighter)], not_heavy(Coins) ), becomes( [untested(Heavier),not_light(Heavier)], not_light(Coins) ), becomes( [ known_true(Lighter), not_light(Lighter), known_true(Heavier), not_heavy(Heavier), all(Table) ], known_true(Coins) ), part( untested, Coins, [] ). </syntaxhighlight> ====becomes( +CollectionA, ?CollectionB )==== <var>CollectionA</var> becomes (part) <var>CollectionB</var> when <var>CollectionB</var> comprises the same coins as <var>CollectionA</var>. <syntaxhighlight lang="prolog"> becomes( CollectionA, CollectionB ) :- unfolded( CollectionA, Coins ), unfolded( CollectionB, Coins ). </syntaxhighlight> ====unfolded( +Collection, ?Coins )==== holds when (part) <var>Collection</var> comprises <var>Coins</var>. <syntaxhighlight lang="prolog"> unfolded( not_light(Collection), Coins ) :- part( not_light, Collection, Coins ). unfolded( not_heavy(Collection), Coins ) :- part( not_heavy, Collection, Coins ). unfolded( known_true(Collection), Coins ) :- part( known_true, Collection, Coins ). unfolded( untested(Collection), Coins ) :- part( untested, Collection, Coins ). unfolded( all(Collection), Coins ) :- collection_to_set( Collection, Coins ). unfolded( [Item|Items], Coins ) :- unfolded( Item, Value ), unfolded1( Items, Value, Coins ). unfolded1( [], Coins, Coins ). unfolded1( [Item|Items], Value, Coins ) :- unfolded( Item, Value0 ), ord_union( Value0, Value, Value1 ), unfolded1( Items, Value1, Coins ). </syntaxhighlight> ==Definite Clause Grammar== The following DCG represents the method for finding the counterfeit coin as a structured procedure. <syntaxhighlight lang="prolog"> general_explanation( Procedure ) --> "Number the coins 1..12", newline, explanation( Procedure, 0 ). explanation( done(Coin, Weight), N ) --> tab( N ), "Conclude that the counterfeit coin is number ", literal( Coin ), ", which is ", literal( Weight ), newline. explanation( Step, N ) --> {step( Step, Left, Right, Table, Branches )}, tab( N ), "BEGIN", newline, tab( N ), "Put ", literal( Left ), " on the left-hand pan", newline, tab( N ), "Put ", literal( Right ), " on the right-hand pan", newline, tab( N ), "Leaving ", literal( Table ), " on the table", newline, branches_explained( Branches, N ), tab( N ), "END", newline. branches_explained( Branches, N ) --> next_step_explained( <, Branches, N ), next_step_explained( >, Branches, N ), next_step_explained( =, Branches, N ). next_step_explained( Result, Branch, N ) --> {branch( Result, Branch, Step )}, ( {var(Step)} -> "" | {nonvar(Step)} -> tab( N ), "If the ", literal( Result ), " then:", newline, explanation( Step, s(N) ) ). literal( 0 ) --> "0". literal( 1 ) --> "1". literal( 2 ) --> "2". literal( 3 ) --> "3". literal( 4 ) --> "4". literal( 5 ) --> "5". literal( 6 ) --> "6". literal( 7 ) --> "7". literal( 8 ) --> "8". literal( 9 ) --> "9". literal( 10 ) --> "10". literal( 11 ) --> "11". literal( 12 ) --> "12". literal( true ) --> "true". literal( heavy ) --> "heavy". literal( light ) --> "light". literal( = ) --> "pans balance". literal( < ) --> "right-hand pan is heavier". literal( > ) --> "left-hand pan is heavier". literal( Collection ) --> {collection_to_set( Collection , [H|T] )}, literal_set( T, H ). literal_set( [], Number ) --> "the coin numbered ", literal( Number ). literal_set( [H|T], Number ) --> "the coins numbered ", literal( Number ), literal_set1( T, H ). literal_set1( [], Number ) --> " and ", literal( Number ). literal_set1( [H|T], Number ) --> ", ", literal( Number ), literal_set1( T, H ). tab( 0 ) --> "". tab( s(N) ) --> " ", tab( N ). newline --> " ". </syntaxhighlight> ===Utility Predicates=== ====contains_coin( ?Collection, ?Coin )==== holds when <var>Coin</var> is a member of <var>Collection</var>. <syntaxhighlight lang="prolog"> contains_coin( Collection, Coin ) :- part( _Part, Collection, Coins ), member( Coin, Coins ). </syntaxhighlight> ====collection_to_set( +Collection, ?Set )==== holds when <var>Set</var> is the distributed union of the <code>known_true</code>, <code>not_heavy</code>, <code>not_light</code> and <code>untested</code> ordsets comprising <var>Collection</var>. <syntaxhighlight lang="prolog"> collection_to_set( Collection, Set ) :- part( known_true, Collection, KnownTrue ), part( not_heavy, Collection, NotHeavy ), part( not_light, Collection, NotLight ), part( untested, Collection, Untested ), ord_union( [KnownTrue,NotHeavy,NotLight,Untested], Set ). </syntaxhighlight> ===Information Content=== ==== information_content( +Counts, ?Content ) ==== holds when <var>Content</var> is the cumulative negative entropy of <var>Counts</var>. A reduction in entropy equates to a gain in information. <syntaxhighlight lang="prolog"> information_content( Counts, Content ) :- information_content1( Counts, 0, Content ). information_content1( [], Content, Content ). information_content1( [Count|Counts], Content0, Content ):- coins_entropy( Count, Entropy ), Content1 is Content0-Entropy, information_content1( Counts, Content1, Content ). </syntaxhighlight> ==== coins_entropy( ?N, ?Entropy ) ==== holds when <var>Entropy</var> estimates the entropy of a sample of <var>N</var> coins. <var>Entropy</var> = P log₂(¹&frasl;_P), where P = <var>N</var>&divide;12. <syntaxhighlight lang="prolog"> coins_entropy( 0, 0.0 ). coins_entropy( 1, 0.2987 ). coins_entropy( 2, 0.4308 ). coins_entropy( 3, 0.5 ). coins_entropy( 4, 0.5283 ). coins_entropy( 5, 0.5263 ). coins_entropy( 6, 0.5 ). coins_entropy( 7, 0.4536 ). coins_entropy( 8, 0.39 ). coins_entropy( 9, 0.3113 ). coins_entropy( 10, 0.2192 ). coins_entropy( 11, 0.1151 ). coins_entropy( 12, 0.0 ). </syntaxhighlight> ====select_coins( +Part, +Coins, ?Sample, ?Residue, ?N )==== holds when <var>N</var> coins from <var>Part</var> of <var>Coins</var> form <var>Part</var> of <var>Sample</var>, with the remainder forming <var>Part</var> of <var>Residue</var>. <syntaxhighlight lang="prolog"> select_coins( Part, Coins, Sample, Residue, Count ) :- part( Part, Coins, Input ), part( Part, Sample, Selection ), part( Part, Residue, Remainder ), select_n( Count, Input, Selection, Remainder ). select_n( 0, In, [], In ). select_n( 1, [A|Suffix], [A], Suffix ). select_n( 2, [A,B|Suffix], [A,B], Suffix ). select_n( 3, [A,B,C|Suffix], [A,B,C], Suffix ). select_n( 4, [A,B,C,D|Suffix], [A,B,C,D], Suffix ). select_n( 5, [A,B,C,D,E|Suffix], [A,B,C,D,E], Suffix ). select_n( 6, [A,B,C,D,E,F|Suffix], [A,B,C,D,E,F], Suffix ). </syntaxhighlight> Load a small library of [[Puzzle Utilities]]. <syntaxhighlight lang="prolog"> :- ensure_loaded( misc ). </syntaxhighlight> Use the ordsets library. <syntaxhighlight lang="prolog"> :- use_module( library(ordsets), [ord_union/2,ord_union/3] ). </syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/download/counterfeit.txt here]. ==Output== <div class="result"> Number the coins 1..12 BEGIN Put the coins numbered 1, 2, 3 and 4 on the left-hand pan Put the coins numbered 5, 6, 7 and 8 on the right-hand pan Leaving the coins numbered 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 1, 2, 5 and 6 on the left-hand pan Put the coins numbered 3, 7, 9 and 10 on the right-hand pan Leaving the coins numbered 4, 8, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 1 and 7 on the left-hand pan Put the coins numbered 3 and 4 on the right-hand pan Leaving the coins numbered 2, 5, 6, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 1, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 7, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 2, which is light END If the left-hand pan is heavier then: BEGIN Put the coins numbered 3 and 5 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 4, 6, 7, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 3, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 5, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 6, which is heavy END If the pans balance then: BEGIN Put the coins numbered 4 and 8 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 3, 5, 6, 7, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 4, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 8, which is heavy END END If the left-hand pan is heavier then: BEGIN Put the coins numbered 1, 2, 5 and 6 on the left-hand pan Put the coins numbered 3, 7, 9 and 10 on the right-hand pan Leaving the coins numbered 4, 8, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 3 and 5 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 4, 6, 7, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 5, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 3, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 6, which is light END If the left-hand pan is heavier then: BEGIN Put the coins numbered 1 and 7 on the left-hand pan Put the coins numbered 3 and 4 on the right-hand pan Leaving the coins numbered 2, 5, 6, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 7, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 1, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 2, which is heavy END If the pans balance then: BEGIN Put the coins numbered 4 and 8 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 3, 5, 6, 7, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 8, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 4, which is heavy END END If the pans balance then: BEGIN Put the coins numbered 9, 10 and 11 on the left-hand pan Put the coins numbered 1, 2 and 3 on the right-hand pan Leaving the coins numbered 4, 5, 6, 7, 8 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coin numbered 9 on the left-hand pan Put the coin numbered 10 on the right-hand pan Leaving the coins numbered 1, 2, 3, 4, 5, 6, 7, 8, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 9, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 10, which is light If the pans balance then: Conclude that the counterfeit coin is number 11, which is light END If the left-hand pan is heavier then: BEGIN Put the coin numbered 9 on the left-hand pan Put the coin numbered 10 on the right-hand pan Leaving the coins numbered 1, 2, 3, 4, 5, 6, 7, 8, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 10, which is heavy If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 9, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 11, which is heavy END If the pans balance then: BEGIN Put the coin numbered 12 on the left-hand pan Put the coin numbered 1 on the right-hand pan Leaving the coins numbered 2, 3, 4, 5, 6, 7, 8, 9, 10 and 11 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 12, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 12, which is heavy END END END </div> ---- be9e67498d410c7d09307338421c2b9bd7680dfd 137 136 2015-10-24T19:49:44Z John 2 /* valid_partition( +Coins, ?Content, ?Left, ?Right, ?Table ) */ wikitext text/x-wiki __NOTOC__ ==Problem Definition== We are given 12 apparently identical coins - one of which is counterfeit. We know that the counterfeit has a different weight from the others, but we don't know if it's heavier or lighter. ===Task:=== Devise a procedure to identify any counterfeit coin using a balance to take up to three comparative weighings. ==Strategy== The information from three suitable weighings will make all but one of the coins, which are untested initially, known_true. There are three alternative deductions that make a coin known_true: * if it is not_heavy and not_light &ndash; having been on both the comparatively lighter and heavier sides of imbalances; * if it was excluded from an imbalance; * if it was included in a balanced weighing. After three weighings there must be exactly one coin, the counterfeit, which is not known_true. If the counterfeit is not known_true and not_heavy we deduce that it must be light. If it is not known_true and not_light, it must be heavy. We use a generate-and-test method as follows: * Create the set of all possible counterfeits: 12 coins &times; 2 weights ; * Devise a procedure that can identify the first counterfeit coin; * Show that the same procedure works for every other counterfeit coin. ==Entry Point== ====go==== is the entry point. It solves the puzzle, then uses a DCG to pretty-print the resulting procedure. <syntaxhighlight lang="prolog"> go :- coins_puzzle( Procedure ), phrase( general_explanation( Procedure ), Chars ), put_chars( Chars ). </syntaxhighlight> ====coins_puzzle( ?Procedure )==== generates the set of all possible counterfeit coins and finds, or proves, that <var>Procedure</var> can identify them all. <syntaxhighlight lang="prolog"> coins_puzzle( Procedure ) :- coins( Coins ), counterfeit( Counterfeit, Coin, Weight ), findall( Counterfeit, (member(Coin,Coins), counterfeit_weight(Weight)), Counterfeits ), coins_puzzle_solution( Counterfeits, Procedure ). coins_puzzle_solution( [], _Procedure ). coins_puzzle_solution( [Counterfeit|Counterfeits], Procedure ) :- solve_coins( Counterfeit, Procedure ), coins_puzzle_solution( Counterfeits, Procedure ). </syntaxhighlight> A procedure is either &lsquo;done&rsquo;, identifying a particular coin and whether it is heavy or light; or it is a &lsquo;step&rsquo;. A step defines the coins to be placed on the <var>Left</var> and <var>Right</var> pans, with the residue remaining on the <var>Table</var>, and three <var>Branches</var>, one of which will be chosen depending on the outcome of the weighing. <syntaxhighlight lang="prolog"> step( step(Left,Right,Table,Branches), Left, Right, Table, Branches). </syntaxhighlight> The <var>Branches</var> are three procedures equating to: * > (left pan heavier), * < (right pan heavier) and * <nowiki>= (pans balance).</nowiki> <syntaxhighlight lang="prolog"> branch( >, branches(_Equal, GT, _LT), GT ). branch( <, branches(_Equal, _GT, LT), LT ). branch( =, branches(Equal, _GT, _LT), Equal ). </syntaxhighlight> The counterfeit is defined by its number and whether it is heavy or light. <syntaxhighlight lang="prolog"> counterfeit( counterfeit(Coin, HeavyOrLight), Coin, HeavyOrLight ). coins( [1,2,3,4,5,6,7,8,9,10,11,12] ). counterfeit_weight( heavy ). counterfeit_weight( light ). </syntaxhighlight> A &lsquo;coin collection&rsquo; comprises four &lsquo;parts&rsquo; (subsets): the <code>known_true</code>, <code>not_heavy</code>, <code>not_light</code> and <code>untested</code> sets of coins. <syntaxhighlight lang="prolog"> part( known_true, collection(Coins,_,_,_), Coins ). part( not_heavy, collection(_,Coins,_,_), Coins ). part( not_light, collection(_,_,Coins,_), Coins ). part( untested, collection(_,_,_,Coins), Coins ). </syntaxhighlight> ==Solution== ====solve_coins( +Counterfeit, ?Procedure )==== holds when <var>Procedure</var> can correctly identify the <var>Counterfeit</var> coin. Beginning with a &lsquo;start&rsquo; collection, in which all the coins are untested, the <var>Procedure</var> comprises three &lsquo;steps&rsquo;. For each step, a weighing is made and a &lsquo;branch&rsquo; is made in the <var>Procedure</var>, depending on the result of the weighing. After three steps, the <var>Procedure</var> must have reached the &lsquo;end&rsquo; condition. Finally, an assertion (redundant test) ensures that the <var>Procedure</var> has found the correct end condition. <syntaxhighlight lang="prolog"> solve_coins( Counterfeit, Procedure ) :- start( Coins0 ), assay( Counterfeit, Coins0, Procedure, Branch1, Coins1 ), assay( Counterfeit, Coins1, Branch1, Branch2, Coins2 ), assay( Counterfeit, Coins2, Branch2, done(Coin, HeavyOrLight), Coins3 ), end( Coins3, Coin, HeavyOrLight ), counterfeit( Counterfeit, Coin, HeavyOrLight ). start( Coins ) :- coins( Untested ), part( untested, Coins, Untested ), part( not_heavy, Coins, [] ), part( not_light, Coins, [] ), part( known_true, Coins, [] ). end( Coins, Coin, HeavyOrLight ) :- part( untested, Coins, [] ), part( not_heavy, Coins, Light ), part( not_light, Coins, Heavy ), end_result( Heavy, Light, Coin, HeavyOrLight ). end_result( [Coin], [], Coin, heavy ). end_result( [], [Coin], Coin, light ). </syntaxhighlight> === Simulating the weighing process === ====assay( +Counterfeit, +Coins0, ?Step, ?Branch, ?Coins1 )==== holds when the appropriate <var>Branch</var> from <var>Step</var> is chosen by comparing the weights of two coin collections taken from the full set of coins: <var>Coins0</var>. <var>Coins1</var> is the full set of coins, updated with the inferences drawn from the weighing. <var>Counterfeit</var> is used to determine the result of the weighing. This predicate applies the critical insight into the solution of this puzzle: we have 24 (12 &times; 2) possible inputs to the procedure, with only 27 (3 &times; 3 &times; 3) possible outcomes from the weighings. Therefore, it is clear that each weighing must have a very high [[#Information Content|information content]]. Choosing which weighing to make by estimating the available information content makes the problem tractable. <syntaxhighlight lang="prolog"> assay( Counterfeit, Coins0, Step, Branch, Coins ) :- WeighingDatum = weighing_data(InfoContent, Left, Right, Table), step( Step, Left, Right, Table, Branches ), findall( WeighingDatum, valid_partition( Coins0, InfoContent, Left, Right, Table ), WeighingData ), sort( WeighingData, OrderedWeighingData ), member( WeighingDatum, OrderedWeighingData ), balance( Left, Right, Counterfeit, Result ), draw_inferences( Result, Left, Right, Table, Coins ), branch( Result, Branches, Branch ). </syntaxhighlight> ====balance( +Left, +Right, +Counterfeit, ?Result )==== holds when <var>Result</var> simulates the outcome of testing the coin collections <var>Left</var> and <var>Right</var> with a balance, where either may contain the <var>Counterfeit</var> coin. <syntaxhighlight lang="prolog"> balance( Left, Right, Counterfeit, Result ):- counterfeit( Counterfeit, Coin, Weight ), ( contains_coin( Left, Coin ) -> balance_result( Weight, normal, Result ) ; contains_coin( Right, Coin ) -> balance_result( normal, Weight, Result ) ; otherwise -> Result = '=' ). balance_result( light, normal, < ). balance_result( heavy, normal, > ). balance_result( normal, heavy, < ). balance_result( normal, light, > ). </syntaxhighlight> ===Choosing which coins to weigh=== ====valid_partition( +Coins, ?Content, ?Left, ?Right, ?Table )==== holds when <var>Coins</var> can be partitioned into three collections: <var>Left</var> side, <var>Right</var> side and <var>Table</var>; with the information content of the partition given by <var>Content</var>. The definition of a valid_partition ensures that: * <var>Left</var> and <var>Right</var> must have the same number of coins (at least one); * <var>Left</var> cannot contain any known_true coins, because adding true coins to both sides creates redundant comparisons; * Symmetry is broken for comparisons between mixtures of coins. <syntaxhighlight lang="prolog"> valid_partition( Coins, Content, Left, Right, Table ):- part( known_true, Left, [] ), selection( Coins, Left, Coins1, LeftSum, LeftInfo ), selection( Coins1, Right, Table, RightSum, RightInfo ), LeftSum =:= RightSum, LeftSum @>= RightSum, table_information( Table, TableInfo ), sum( [LeftInfo,RightInfo,TableInfo], Content ). </syntaxhighlight> ====selection( +Coins, ?Sample, ?Residue, ?Count, ?Content )==== holds when <var>Coins</var> is partitioned into two collections: <var>Sample</var> and <var>Residue</var>. <var>Count</var> is a sum used as both a fingerprint for the mixture of coins in <var>Sample</var> and a representation of the number of coins in <var>Sample</var>. <var>Content</var> estimates the information-content of <var>Sample</var>. <syntaxhighlight lang="prolog"> selection( Coins, Sample, Residue, Count, Content ) :- Count = Count1+Count2+Count3+Count4, select_coins( not_heavy, Coins, Sample, Residue, Count1 ), select_coins( not_light, Coins, Sample, Residue, Count2 ), select_coins( untested, Coins, Sample, Residue, Count3 ), select_coins( known_true, Coins, Sample, Residue, Count4 ), Count >= 1, Count =< 6, information_content( [Count1,Count2,Count3,Count4], Content ). </syntaxhighlight> ====table_information( +Coins, ?Content )==== holds when <var>Coins</var> has 'information content' <var>Content</var>. <syntaxhighlight lang="prolog"> table_information( Coins, Content ) :- count_coins( not_heavy, Coins, Count1 ), count_coins( not_light, Coins, Count2 ), count_coins( untested, Coins, Count3 ), count_coins( known_true, Coins, Count4 ), information_content( [Count1,Count2,Count3,Count4], Content ). count_coins( Part, Coins, Count ) :- part( Part, Coins, Selection ), length( Selection, Count ). </syntaxhighlight> === Updating what is known about the coins === ====draw_inferences( +Result, +Left, +Right, +Table, ?Coins )==== holds when <var>Result</var> is one of: * > (imbalance &ndash; left pan heavier), * < (imbalance &ndash; right pan heavier) or * <nowiki>=</nowiki> (pans balanced) from taking a weighing with the coin collections: <var>Left</var>, <var>Right</var> and <var>Table</var>. <var>Coins</var> is derived from this information using the following rules: * If the pans are unbalanced then only the previously untested or not_heavy coins on the lighter side of the balance are now not_heavy. Similarly, only the previously untested or not_light coins on the heavier side of the balance are now not_light. All the coins on the table are now known_true. * If the pans balance then all the coins weighed are known_true, with the coins on the <var>Table</var> left in their prior states. <syntaxhighlight lang="prolog"> draw_inferences( <, Left, Right, Table, Coins ) :- imbalance_inferences( Left, Right, Table, Coins ). draw_inferences( >, Left, Right, Table, Coins ) :- imbalance_inferences( Right, Left, Table, Coins ). draw_inferences( =, Left, Right, Table, Coins ) :- becomes( [all(Left),known_true(Table),all(Right)], known_true( Coins ) ), becomes( untested(Table), untested(Coins) ), becomes( not_heavy(Table), not_heavy(Coins) ), becomes( not_light(Table), not_light(Coins) ). </syntaxhighlight> ====imbalance_inferences( +Lighter, +Heavier, +Table, ?Coins )==== holds when: * Only the untested or not_heavy coins in <var>Lighter</var> are not_heavy in <var>Coins</var>; * Only the untested or not_light coins in <var>Heavier</var> are not_light in <var>Coins</var>; * All the other coins in <var>Lighter</var> and <var>Heavier</var> and all the coins in <var>Table</var> are known_true in <var>Coins</var>; There are no untested coins in <var>Coins</var>. <syntaxhighlight lang="prolog"> imbalance_inferences( Lighter, Heavier, Table, Coins ) :- becomes( [untested(Lighter),not_heavy(Lighter)], not_heavy(Coins) ), becomes( [untested(Heavier),not_light(Heavier)], not_light(Coins) ), becomes( [ known_true(Lighter), not_light(Lighter), known_true(Heavier), not_heavy(Heavier), all(Table) ], known_true(Coins) ), part( untested, Coins, [] ). </syntaxhighlight> ====becomes( +CollectionA, ?CollectionB )==== <var>CollectionA</var> becomes (part) <var>CollectionB</var> when <var>CollectionB</var> comprises the same coins as <var>CollectionA</var>. <syntaxhighlight lang="prolog"> becomes( CollectionA, CollectionB ) :- unfolded( CollectionA, Coins ), unfolded( CollectionB, Coins ). </syntaxhighlight> ====unfolded( +Collection, ?Coins )==== holds when (part) <var>Collection</var> comprises <var>Coins</var>. <syntaxhighlight lang="prolog"> unfolded( not_light(Collection), Coins ) :- part( not_light, Collection, Coins ). unfolded( not_heavy(Collection), Coins ) :- part( not_heavy, Collection, Coins ). unfolded( known_true(Collection), Coins ) :- part( known_true, Collection, Coins ). unfolded( untested(Collection), Coins ) :- part( untested, Collection, Coins ). unfolded( all(Collection), Coins ) :- collection_to_set( Collection, Coins ). unfolded( [Item|Items], Coins ) :- unfolded( Item, Value ), unfolded1( Items, Value, Coins ). unfolded1( [], Coins, Coins ). unfolded1( [Item|Items], Value, Coins ) :- unfolded( Item, Value0 ), ord_union( Value0, Value, Value1 ), unfolded1( Items, Value1, Coins ). </syntaxhighlight> ==Definite Clause Grammar== The following DCG represents the method for finding the counterfeit coin as a structured procedure. <syntaxhighlight lang="prolog"> general_explanation( Procedure ) --> "Number the coins 1..12", newline, explanation( Procedure, 0 ). explanation( done(Coin, Weight), N ) --> tab( N ), "Conclude that the counterfeit coin is number ", literal( Coin ), ", which is ", literal( Weight ), newline. explanation( Step, N ) --> {step( Step, Left, Right, Table, Branches )}, tab( N ), "BEGIN", newline, tab( N ), "Put ", literal( Left ), " on the left-hand pan", newline, tab( N ), "Put ", literal( Right ), " on the right-hand pan", newline, tab( N ), "Leaving ", literal( Table ), " on the table", newline, branches_explained( Branches, N ), tab( N ), "END", newline. branches_explained( Branches, N ) --> next_step_explained( <, Branches, N ), next_step_explained( >, Branches, N ), next_step_explained( =, Branches, N ). next_step_explained( Result, Branch, N ) --> {branch( Result, Branch, Step )}, ( {var(Step)} -> "" | {nonvar(Step)} -> tab( N ), "If the ", literal( Result ), " then:", newline, explanation( Step, s(N) ) ). literal( 0 ) --> "0". literal( 1 ) --> "1". literal( 2 ) --> "2". literal( 3 ) --> "3". literal( 4 ) --> "4". literal( 5 ) --> "5". literal( 6 ) --> "6". literal( 7 ) --> "7". literal( 8 ) --> "8". literal( 9 ) --> "9". literal( 10 ) --> "10". literal( 11 ) --> "11". literal( 12 ) --> "12". literal( true ) --> "true". literal( heavy ) --> "heavy". literal( light ) --> "light". literal( = ) --> "pans balance". literal( < ) --> "right-hand pan is heavier". literal( > ) --> "left-hand pan is heavier". literal( Collection ) --> {collection_to_set( Collection , [H|T] )}, literal_set( T, H ). literal_set( [], Number ) --> "the coin numbered ", literal( Number ). literal_set( [H|T], Number ) --> "the coins numbered ", literal( Number ), literal_set1( T, H ). literal_set1( [], Number ) --> " and ", literal( Number ). literal_set1( [H|T], Number ) --> ", ", literal( Number ), literal_set1( T, H ). tab( 0 ) --> "". tab( s(N) ) --> " ", tab( N ). newline --> " ". </syntaxhighlight> ===Utility Predicates=== ====contains_coin( ?Collection, ?Coin )==== holds when <var>Coin</var> is a member of <var>Collection</var>. <syntaxhighlight lang="prolog"> contains_coin( Collection, Coin ) :- part( _Part, Collection, Coins ), member( Coin, Coins ). </syntaxhighlight> ====collection_to_set( +Collection, ?Set )==== holds when <var>Set</var> is the distributed union of the <code>known_true</code>, <code>not_heavy</code>, <code>not_light</code> and <code>untested</code> ordsets comprising <var>Collection</var>. <syntaxhighlight lang="prolog"> collection_to_set( Collection, Set ) :- part( known_true, Collection, KnownTrue ), part( not_heavy, Collection, NotHeavy ), part( not_light, Collection, NotLight ), part( untested, Collection, Untested ), ord_union( [KnownTrue,NotHeavy,NotLight,Untested], Set ). </syntaxhighlight> ===Information Content=== ==== information_content( +Counts, ?Content ) ==== holds when <var>Content</var> is the cumulative negative entropy of <var>Counts</var>. A reduction in entropy equates to a gain in information. <syntaxhighlight lang="prolog"> information_content( Counts, Content ) :- information_content1( Counts, 0, Content ). information_content1( [], Content, Content ). information_content1( [Count|Counts], Content0, Content ):- coins_entropy( Count, Entropy ), Content1 is Content0-Entropy, information_content1( Counts, Content1, Content ). </syntaxhighlight> ==== coins_entropy( ?N, ?Entropy ) ==== holds when <var>Entropy</var> estimates the entropy of a sample of <var>N</var> coins. <var>Entropy</var> = P log₂(¹&frasl;_P), where P = <var>N</var>&divide;12. <syntaxhighlight lang="prolog"> coins_entropy( 0, 0.0 ). coins_entropy( 1, 0.2987 ). coins_entropy( 2, 0.4308 ). coins_entropy( 3, 0.5 ). coins_entropy( 4, 0.5283 ). coins_entropy( 5, 0.5263 ). coins_entropy( 6, 0.5 ). coins_entropy( 7, 0.4536 ). coins_entropy( 8, 0.39 ). coins_entropy( 9, 0.3113 ). coins_entropy( 10, 0.2192 ). coins_entropy( 11, 0.1151 ). coins_entropy( 12, 0.0 ). </syntaxhighlight> ====select_coins( +Part, +Coins, ?Sample, ?Residue, ?N )==== holds when <var>N</var> coins from <var>Part</var> of <var>Coins</var> form <var>Part</var> of <var>Sample</var>, with the remainder forming <var>Part</var> of <var>Residue</var>. <syntaxhighlight lang="prolog"> select_coins( Part, Coins, Sample, Residue, Count ) :- part( Part, Coins, Input ), part( Part, Sample, Selection ), part( Part, Residue, Remainder ), select_n( Count, Input, Selection, Remainder ). select_n( 0, In, [], In ). select_n( 1, [A|Suffix], [A], Suffix ). select_n( 2, [A,B|Suffix], [A,B], Suffix ). select_n( 3, [A,B,C|Suffix], [A,B,C], Suffix ). select_n( 4, [A,B,C,D|Suffix], [A,B,C,D], Suffix ). select_n( 5, [A,B,C,D,E|Suffix], [A,B,C,D,E], Suffix ). select_n( 6, [A,B,C,D,E,F|Suffix], [A,B,C,D,E,F], Suffix ). </syntaxhighlight> Load a small library of [[Puzzle Utilities]]. <syntaxhighlight lang="prolog"> :- ensure_loaded( misc ). </syntaxhighlight> Use the ordsets library. <syntaxhighlight lang="prolog"> :- use_module( library(ordsets), [ord_union/2,ord_union/3] ). </syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/download/counterfeit.txt here]. ==Output== <div class="result"> Number the coins 1..12 BEGIN Put the coins numbered 1, 2, 3 and 4 on the left-hand pan Put the coins numbered 5, 6, 7 and 8 on the right-hand pan Leaving the coins numbered 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 1, 2, 5 and 6 on the left-hand pan Put the coins numbered 3, 7, 9 and 10 on the right-hand pan Leaving the coins numbered 4, 8, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 1 and 7 on the left-hand pan Put the coins numbered 3 and 4 on the right-hand pan Leaving the coins numbered 2, 5, 6, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 1, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 7, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 2, which is light END If the left-hand pan is heavier then: BEGIN Put the coins numbered 3 and 5 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 4, 6, 7, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 3, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 5, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 6, which is heavy END If the pans balance then: BEGIN Put the coins numbered 4 and 8 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 3, 5, 6, 7, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 4, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 8, which is heavy END END If the left-hand pan is heavier then: BEGIN Put the coins numbered 1, 2, 5 and 6 on the left-hand pan Put the coins numbered 3, 7, 9 and 10 on the right-hand pan Leaving the coins numbered 4, 8, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 3 and 5 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 4, 6, 7, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 5, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 3, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 6, which is light END If the left-hand pan is heavier then: BEGIN Put the coins numbered 1 and 7 on the left-hand pan Put the coins numbered 3 and 4 on the right-hand pan Leaving the coins numbered 2, 5, 6, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 7, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 1, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 2, which is heavy END If the pans balance then: BEGIN Put the coins numbered 4 and 8 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 3, 5, 6, 7, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 8, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 4, which is heavy END END If the pans balance then: BEGIN Put the coins numbered 9, 10 and 11 on the left-hand pan Put the coins numbered 1, 2 and 3 on the right-hand pan Leaving the coins numbered 4, 5, 6, 7, 8 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coin numbered 9 on the left-hand pan Put the coin numbered 10 on the right-hand pan Leaving the coins numbered 1, 2, 3, 4, 5, 6, 7, 8, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 9, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 10, which is light If the pans balance then: Conclude that the counterfeit coin is number 11, which is light END If the left-hand pan is heavier then: BEGIN Put the coin numbered 9 on the left-hand pan Put the coin numbered 10 on the right-hand pan Leaving the coins numbered 1, 2, 3, 4, 5, 6, 7, 8, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 10, which is heavy If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 9, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 11, which is heavy END If the pans balance then: BEGIN Put the coin numbered 12 on the left-hand pan Put the coin numbered 1 on the right-hand pan Leaving the coins numbered 2, 3, 4, 5, 6, 7, 8, 9, 10 and 11 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 12, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 12, which is heavy END END END </div> ---- e8da9ad9ec5987674012aa963fa6868b40ee7a28 138 137 2015-10-24T19:51:53Z John 2 /* selection( +Coins, ?Sample, ?Residue, ?Count, ?Content ) */ wikitext text/x-wiki __NOTOC__ ==Problem Definition== We are given 12 apparently identical coins - one of which is counterfeit. We know that the counterfeit has a different weight from the others, but we don't know if it's heavier or lighter. ===Task:=== Devise a procedure to identify any counterfeit coin using a balance to take up to three comparative weighings. ==Strategy== The information from three suitable weighings will make all but one of the coins, which are untested initially, known_true. There are three alternative deductions that make a coin known_true: * if it is not_heavy and not_light &ndash; having been on both the comparatively lighter and heavier sides of imbalances; * if it was excluded from an imbalance; * if it was included in a balanced weighing. After three weighings there must be exactly one coin, the counterfeit, which is not known_true. If the counterfeit is not known_true and not_heavy we deduce that it must be light. If it is not known_true and not_light, it must be heavy. We use a generate-and-test method as follows: * Create the set of all possible counterfeits: 12 coins &times; 2 weights ; * Devise a procedure that can identify the first counterfeit coin; * Show that the same procedure works for every other counterfeit coin. ==Entry Point== ====go==== is the entry point. It solves the puzzle, then uses a DCG to pretty-print the resulting procedure. <syntaxhighlight lang="prolog"> go :- coins_puzzle( Procedure ), phrase( general_explanation( Procedure ), Chars ), put_chars( Chars ). </syntaxhighlight> ====coins_puzzle( ?Procedure )==== generates the set of all possible counterfeit coins and finds, or proves, that <var>Procedure</var> can identify them all. <syntaxhighlight lang="prolog"> coins_puzzle( Procedure ) :- coins( Coins ), counterfeit( Counterfeit, Coin, Weight ), findall( Counterfeit, (member(Coin,Coins), counterfeit_weight(Weight)), Counterfeits ), coins_puzzle_solution( Counterfeits, Procedure ). coins_puzzle_solution( [], _Procedure ). coins_puzzle_solution( [Counterfeit|Counterfeits], Procedure ) :- solve_coins( Counterfeit, Procedure ), coins_puzzle_solution( Counterfeits, Procedure ). </syntaxhighlight> A procedure is either &lsquo;done&rsquo;, identifying a particular coin and whether it is heavy or light; or it is a &lsquo;step&rsquo;. A step defines the coins to be placed on the <var>Left</var> and <var>Right</var> pans, with the residue remaining on the <var>Table</var>, and three <var>Branches</var>, one of which will be chosen depending on the outcome of the weighing. <syntaxhighlight lang="prolog"> step( step(Left,Right,Table,Branches), Left, Right, Table, Branches). </syntaxhighlight> The <var>Branches</var> are three procedures equating to: * > (left pan heavier), * < (right pan heavier) and * <nowiki>= (pans balance).</nowiki> <syntaxhighlight lang="prolog"> branch( >, branches(_Equal, GT, _LT), GT ). branch( <, branches(_Equal, _GT, LT), LT ). branch( =, branches(Equal, _GT, _LT), Equal ). </syntaxhighlight> The counterfeit is defined by its number and whether it is heavy or light. <syntaxhighlight lang="prolog"> counterfeit( counterfeit(Coin, HeavyOrLight), Coin, HeavyOrLight ). coins( [1,2,3,4,5,6,7,8,9,10,11,12] ). counterfeit_weight( heavy ). counterfeit_weight( light ). </syntaxhighlight> A &lsquo;coin collection&rsquo; comprises four &lsquo;parts&rsquo; (subsets): the <code>known_true</code>, <code>not_heavy</code>, <code>not_light</code> and <code>untested</code> sets of coins. <syntaxhighlight lang="prolog"> part( known_true, collection(Coins,_,_,_), Coins ). part( not_heavy, collection(_,Coins,_,_), Coins ). part( not_light, collection(_,_,Coins,_), Coins ). part( untested, collection(_,_,_,Coins), Coins ). </syntaxhighlight> ==Solution== ====solve_coins( +Counterfeit, ?Procedure )==== holds when <var>Procedure</var> can correctly identify the <var>Counterfeit</var> coin. Beginning with a &lsquo;start&rsquo; collection, in which all the coins are untested, the <var>Procedure</var> comprises three &lsquo;steps&rsquo;. For each step, a weighing is made and a &lsquo;branch&rsquo; is made in the <var>Procedure</var>, depending on the result of the weighing. After three steps, the <var>Procedure</var> must have reached the &lsquo;end&rsquo; condition. Finally, an assertion (redundant test) ensures that the <var>Procedure</var> has found the correct end condition. <syntaxhighlight lang="prolog"> solve_coins( Counterfeit, Procedure ) :- start( Coins0 ), assay( Counterfeit, Coins0, Procedure, Branch1, Coins1 ), assay( Counterfeit, Coins1, Branch1, Branch2, Coins2 ), assay( Counterfeit, Coins2, Branch2, done(Coin, HeavyOrLight), Coins3 ), end( Coins3, Coin, HeavyOrLight ), counterfeit( Counterfeit, Coin, HeavyOrLight ). start( Coins ) :- coins( Untested ), part( untested, Coins, Untested ), part( not_heavy, Coins, [] ), part( not_light, Coins, [] ), part( known_true, Coins, [] ). end( Coins, Coin, HeavyOrLight ) :- part( untested, Coins, [] ), part( not_heavy, Coins, Light ), part( not_light, Coins, Heavy ), end_result( Heavy, Light, Coin, HeavyOrLight ). end_result( [Coin], [], Coin, heavy ). end_result( [], [Coin], Coin, light ). </syntaxhighlight> === Simulating the weighing process === ====assay( +Counterfeit, +Coins0, ?Step, ?Branch, ?Coins1 )==== holds when the appropriate <var>Branch</var> from <var>Step</var> is chosen by comparing the weights of two coin collections taken from the full set of coins: <var>Coins0</var>. <var>Coins1</var> is the full set of coins, updated with the inferences drawn from the weighing. <var>Counterfeit</var> is used to determine the result of the weighing. This predicate applies the critical insight into the solution of this puzzle: we have 24 (12 &times; 2) possible inputs to the procedure, with only 27 (3 &times; 3 &times; 3) possible outcomes from the weighings. Therefore, it is clear that each weighing must have a very high [[#Information Content|information content]]. Choosing which weighing to make by estimating the available information content makes the problem tractable. <syntaxhighlight lang="prolog"> assay( Counterfeit, Coins0, Step, Branch, Coins ) :- WeighingDatum = weighing_data(InfoContent, Left, Right, Table), step( Step, Left, Right, Table, Branches ), findall( WeighingDatum, valid_partition( Coins0, InfoContent, Left, Right, Table ), WeighingData ), sort( WeighingData, OrderedWeighingData ), member( WeighingDatum, OrderedWeighingData ), balance( Left, Right, Counterfeit, Result ), draw_inferences( Result, Left, Right, Table, Coins ), branch( Result, Branches, Branch ). </syntaxhighlight> ====balance( +Left, +Right, +Counterfeit, ?Result )==== holds when <var>Result</var> simulates the outcome of testing the coin collections <var>Left</var> and <var>Right</var> with a balance, where either may contain the <var>Counterfeit</var> coin. <syntaxhighlight lang="prolog"> balance( Left, Right, Counterfeit, Result ):- counterfeit( Counterfeit, Coin, Weight ), ( contains_coin( Left, Coin ) -> balance_result( Weight, normal, Result ) ; contains_coin( Right, Coin ) -> balance_result( normal, Weight, Result ) ; otherwise -> Result = '=' ). balance_result( light, normal, < ). balance_result( heavy, normal, > ). balance_result( normal, heavy, < ). balance_result( normal, light, > ). </syntaxhighlight> ===Choosing which coins to weigh=== ====valid_partition( +Coins, ?Content, ?Left, ?Right, ?Table )==== holds when <var>Coins</var> can be partitioned into three collections: <var>Left</var> side, <var>Right</var> side and <var>Table</var>; with the information content of the partition given by <var>Content</var>. The definition of a valid_partition ensures that: * <var>Left</var> and <var>Right</var> must have the same number of coins (at least one); * <var>Left</var> cannot contain any known_true coins, because adding true coins to both sides creates redundant comparisons; * Symmetry is broken for comparisons between mixtures of coins. <syntaxhighlight lang="prolog"> valid_partition( Coins, Content, Left, Right, Table ):- part( known_true, Left, [] ), selection( Coins, Left, Coins1, LeftSum, LeftInfo ), selection( Coins1, Right, Table, RightSum, RightInfo ), LeftSum =:= RightSum, LeftSum @>= RightSum, table_information( Table, TableInfo ), sum( [LeftInfo,RightInfo,TableInfo], Content ). </syntaxhighlight> ====selection( +Coins, ?Sample, ?Residue, ?Sum, ?Content )==== holds when <var>Coins</var> is partitioned into two collections: <var>Sample</var> and <var>Residue</var>. <var>Sum</var> is used as both a fingerprint for the mixture of coins in <var>Sample</var> and a representation of the number of coins in <var>Sample</var>. <var>Content</var> estimates the information-content of <var>Sample</var>. <syntaxhighlight lang="prolog"> selection( Coins, Sample, Residue, Sum, Content ) :- Sum = Count1+Count2+Count3+Count4, select_coins( not_heavy, Coins, Sample, Residue, Count1 ), select_coins( not_light, Coins, Sample, Residue, Count2 ), select_coins( untested, Coins, Sample, Residue, Count3 ), select_coins( known_true, Coins, Sample, Residue, Count4 ), Sum >= 1, Sum =< 6, information_content( [Count1,Count2,Count3,Count4], Content ). </syntaxhighlight> ====table_information( +Coins, ?Content )==== holds when <var>Coins</var> has 'information content' <var>Content</var>. <syntaxhighlight lang="prolog"> table_information( Coins, Content ) :- count_coins( not_heavy, Coins, Count1 ), count_coins( not_light, Coins, Count2 ), count_coins( untested, Coins, Count3 ), count_coins( known_true, Coins, Count4 ), information_content( [Count1,Count2,Count3,Count4], Content ). count_coins( Part, Coins, Count ) :- part( Part, Coins, Selection ), length( Selection, Count ). </syntaxhighlight> === Updating what is known about the coins === ====draw_inferences( +Result, +Left, +Right, +Table, ?Coins )==== holds when <var>Result</var> is one of: * > (imbalance &ndash; left pan heavier), * < (imbalance &ndash; right pan heavier) or * <nowiki>=</nowiki> (pans balanced) from taking a weighing with the coin collections: <var>Left</var>, <var>Right</var> and <var>Table</var>. <var>Coins</var> is derived from this information using the following rules: * If the pans are unbalanced then only the previously untested or not_heavy coins on the lighter side of the balance are now not_heavy. Similarly, only the previously untested or not_light coins on the heavier side of the balance are now not_light. All the coins on the table are now known_true. * If the pans balance then all the coins weighed are known_true, with the coins on the <var>Table</var> left in their prior states. <syntaxhighlight lang="prolog"> draw_inferences( <, Left, Right, Table, Coins ) :- imbalance_inferences( Left, Right, Table, Coins ). draw_inferences( >, Left, Right, Table, Coins ) :- imbalance_inferences( Right, Left, Table, Coins ). draw_inferences( =, Left, Right, Table, Coins ) :- becomes( [all(Left),known_true(Table),all(Right)], known_true( Coins ) ), becomes( untested(Table), untested(Coins) ), becomes( not_heavy(Table), not_heavy(Coins) ), becomes( not_light(Table), not_light(Coins) ). </syntaxhighlight> ====imbalance_inferences( +Lighter, +Heavier, +Table, ?Coins )==== holds when: * Only the untested or not_heavy coins in <var>Lighter</var> are not_heavy in <var>Coins</var>; * Only the untested or not_light coins in <var>Heavier</var> are not_light in <var>Coins</var>; * All the other coins in <var>Lighter</var> and <var>Heavier</var> and all the coins in <var>Table</var> are known_true in <var>Coins</var>; There are no untested coins in <var>Coins</var>. <syntaxhighlight lang="prolog"> imbalance_inferences( Lighter, Heavier, Table, Coins ) :- becomes( [untested(Lighter),not_heavy(Lighter)], not_heavy(Coins) ), becomes( [untested(Heavier),not_light(Heavier)], not_light(Coins) ), becomes( [ known_true(Lighter), not_light(Lighter), known_true(Heavier), not_heavy(Heavier), all(Table) ], known_true(Coins) ), part( untested, Coins, [] ). </syntaxhighlight> ====becomes( +CollectionA, ?CollectionB )==== <var>CollectionA</var> becomes (part) <var>CollectionB</var> when <var>CollectionB</var> comprises the same coins as <var>CollectionA</var>. <syntaxhighlight lang="prolog"> becomes( CollectionA, CollectionB ) :- unfolded( CollectionA, Coins ), unfolded( CollectionB, Coins ). </syntaxhighlight> ====unfolded( +Collection, ?Coins )==== holds when (part) <var>Collection</var> comprises <var>Coins</var>. <syntaxhighlight lang="prolog"> unfolded( not_light(Collection), Coins ) :- part( not_light, Collection, Coins ). unfolded( not_heavy(Collection), Coins ) :- part( not_heavy, Collection, Coins ). unfolded( known_true(Collection), Coins ) :- part( known_true, Collection, Coins ). unfolded( untested(Collection), Coins ) :- part( untested, Collection, Coins ). unfolded( all(Collection), Coins ) :- collection_to_set( Collection, Coins ). unfolded( [Item|Items], Coins ) :- unfolded( Item, Value ), unfolded1( Items, Value, Coins ). unfolded1( [], Coins, Coins ). unfolded1( [Item|Items], Value, Coins ) :- unfolded( Item, Value0 ), ord_union( Value0, Value, Value1 ), unfolded1( Items, Value1, Coins ). </syntaxhighlight> ==Definite Clause Grammar== The following DCG represents the method for finding the counterfeit coin as a structured procedure. <syntaxhighlight lang="prolog"> general_explanation( Procedure ) --> "Number the coins 1..12", newline, explanation( Procedure, 0 ). explanation( done(Coin, Weight), N ) --> tab( N ), "Conclude that the counterfeit coin is number ", literal( Coin ), ", which is ", literal( Weight ), newline. explanation( Step, N ) --> {step( Step, Left, Right, Table, Branches )}, tab( N ), "BEGIN", newline, tab( N ), "Put ", literal( Left ), " on the left-hand pan", newline, tab( N ), "Put ", literal( Right ), " on the right-hand pan", newline, tab( N ), "Leaving ", literal( Table ), " on the table", newline, branches_explained( Branches, N ), tab( N ), "END", newline. branches_explained( Branches, N ) --> next_step_explained( <, Branches, N ), next_step_explained( >, Branches, N ), next_step_explained( =, Branches, N ). next_step_explained( Result, Branch, N ) --> {branch( Result, Branch, Step )}, ( {var(Step)} -> "" | {nonvar(Step)} -> tab( N ), "If the ", literal( Result ), " then:", newline, explanation( Step, s(N) ) ). literal( 0 ) --> "0". literal( 1 ) --> "1". literal( 2 ) --> "2". literal( 3 ) --> "3". literal( 4 ) --> "4". literal( 5 ) --> "5". literal( 6 ) --> "6". literal( 7 ) --> "7". literal( 8 ) --> "8". literal( 9 ) --> "9". literal( 10 ) --> "10". literal( 11 ) --> "11". literal( 12 ) --> "12". literal( true ) --> "true". literal( heavy ) --> "heavy". literal( light ) --> "light". literal( = ) --> "pans balance". literal( < ) --> "right-hand pan is heavier". literal( > ) --> "left-hand pan is heavier". literal( Collection ) --> {collection_to_set( Collection , [H|T] )}, literal_set( T, H ). literal_set( [], Number ) --> "the coin numbered ", literal( Number ). literal_set( [H|T], Number ) --> "the coins numbered ", literal( Number ), literal_set1( T, H ). literal_set1( [], Number ) --> " and ", literal( Number ). literal_set1( [H|T], Number ) --> ", ", literal( Number ), literal_set1( T, H ). tab( 0 ) --> "". tab( s(N) ) --> " ", tab( N ). newline --> " ". </syntaxhighlight> ===Utility Predicates=== ====contains_coin( ?Collection, ?Coin )==== holds when <var>Coin</var> is a member of <var>Collection</var>. <syntaxhighlight lang="prolog"> contains_coin( Collection, Coin ) :- part( _Part, Collection, Coins ), member( Coin, Coins ). </syntaxhighlight> ====collection_to_set( +Collection, ?Set )==== holds when <var>Set</var> is the distributed union of the <code>known_true</code>, <code>not_heavy</code>, <code>not_light</code> and <code>untested</code> ordsets comprising <var>Collection</var>. <syntaxhighlight lang="prolog"> collection_to_set( Collection, Set ) :- part( known_true, Collection, KnownTrue ), part( not_heavy, Collection, NotHeavy ), part( not_light, Collection, NotLight ), part( untested, Collection, Untested ), ord_union( [KnownTrue,NotHeavy,NotLight,Untested], Set ). </syntaxhighlight> ===Information Content=== ==== information_content( +Counts, ?Content ) ==== holds when <var>Content</var> is the cumulative negative entropy of <var>Counts</var>. A reduction in entropy equates to a gain in information. <syntaxhighlight lang="prolog"> information_content( Counts, Content ) :- information_content1( Counts, 0, Content ). information_content1( [], Content, Content ). information_content1( [Count|Counts], Content0, Content ):- coins_entropy( Count, Entropy ), Content1 is Content0-Entropy, information_content1( Counts, Content1, Content ). </syntaxhighlight> ==== coins_entropy( ?N, ?Entropy ) ==== holds when <var>Entropy</var> estimates the entropy of a sample of <var>N</var> coins. <var>Entropy</var> = P log₂(¹&frasl;_P), where P = <var>N</var>&divide;12. <syntaxhighlight lang="prolog"> coins_entropy( 0, 0.0 ). coins_entropy( 1, 0.2987 ). coins_entropy( 2, 0.4308 ). coins_entropy( 3, 0.5 ). coins_entropy( 4, 0.5283 ). coins_entropy( 5, 0.5263 ). coins_entropy( 6, 0.5 ). coins_entropy( 7, 0.4536 ). coins_entropy( 8, 0.39 ). coins_entropy( 9, 0.3113 ). coins_entropy( 10, 0.2192 ). coins_entropy( 11, 0.1151 ). coins_entropy( 12, 0.0 ). </syntaxhighlight> ====select_coins( +Part, +Coins, ?Sample, ?Residue, ?N )==== holds when <var>N</var> coins from <var>Part</var> of <var>Coins</var> form <var>Part</var> of <var>Sample</var>, with the remainder forming <var>Part</var> of <var>Residue</var>. <syntaxhighlight lang="prolog"> select_coins( Part, Coins, Sample, Residue, Count ) :- part( Part, Coins, Input ), part( Part, Sample, Selection ), part( Part, Residue, Remainder ), select_n( Count, Input, Selection, Remainder ). select_n( 0, In, [], In ). select_n( 1, [A|Suffix], [A], Suffix ). select_n( 2, [A,B|Suffix], [A,B], Suffix ). select_n( 3, [A,B,C|Suffix], [A,B,C], Suffix ). select_n( 4, [A,B,C,D|Suffix], [A,B,C,D], Suffix ). select_n( 5, [A,B,C,D,E|Suffix], [A,B,C,D,E], Suffix ). select_n( 6, [A,B,C,D,E,F|Suffix], [A,B,C,D,E,F], Suffix ). </syntaxhighlight> Load a small library of [[Puzzle Utilities]]. <syntaxhighlight lang="prolog"> :- ensure_loaded( misc ). </syntaxhighlight> Use the ordsets library. <syntaxhighlight lang="prolog"> :- use_module( library(ordsets), [ord_union/2,ord_union/3] ). </syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/download/counterfeit.txt here]. ==Output== <div class="result"> Number the coins 1..12 BEGIN Put the coins numbered 1, 2, 3 and 4 on the left-hand pan Put the coins numbered 5, 6, 7 and 8 on the right-hand pan Leaving the coins numbered 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 1, 2, 5 and 6 on the left-hand pan Put the coins numbered 3, 7, 9 and 10 on the right-hand pan Leaving the coins numbered 4, 8, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 1 and 7 on the left-hand pan Put the coins numbered 3 and 4 on the right-hand pan Leaving the coins numbered 2, 5, 6, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 1, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 7, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 2, which is light END If the left-hand pan is heavier then: BEGIN Put the coins numbered 3 and 5 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 4, 6, 7, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 3, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 5, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 6, which is heavy END If the pans balance then: BEGIN Put the coins numbered 4 and 8 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 3, 5, 6, 7, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 4, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 8, which is heavy END END If the left-hand pan is heavier then: BEGIN Put the coins numbered 1, 2, 5 and 6 on the left-hand pan Put the coins numbered 3, 7, 9 and 10 on the right-hand pan Leaving the coins numbered 4, 8, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 3 and 5 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 4, 6, 7, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 5, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 3, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 6, which is light END If the left-hand pan is heavier then: BEGIN Put the coins numbered 1 and 7 on the left-hand pan Put the coins numbered 3 and 4 on the right-hand pan Leaving the coins numbered 2, 5, 6, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 7, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 1, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 2, which is heavy END If the pans balance then: BEGIN Put the coins numbered 4 and 8 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 3, 5, 6, 7, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 8, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 4, which is heavy END END If the pans balance then: BEGIN Put the coins numbered 9, 10 and 11 on the left-hand pan Put the coins numbered 1, 2 and 3 on the right-hand pan Leaving the coins numbered 4, 5, 6, 7, 8 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coin numbered 9 on the left-hand pan Put the coin numbered 10 on the right-hand pan Leaving the coins numbered 1, 2, 3, 4, 5, 6, 7, 8, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 9, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 10, which is light If the pans balance then: Conclude that the counterfeit coin is number 11, which is light END If the left-hand pan is heavier then: BEGIN Put the coin numbered 9 on the left-hand pan Put the coin numbered 10 on the right-hand pan Leaving the coins numbered 1, 2, 3, 4, 5, 6, 7, 8, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 10, which is heavy If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 9, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 11, which is heavy END If the pans balance then: BEGIN Put the coin numbered 12 on the left-hand pan Put the coin numbered 1 on the right-hand pan Leaving the coins numbered 2, 3, 4, 5, 6, 7, 8, 9, 10 and 11 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 12, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 12, which is heavy END END END </div> ---- 36d19041095804a2c601e8ad42ba9852adbda2bb 139 138 2015-10-25T11:49:47Z John 2 /* valid_partition( +Coins, ?Content, ?Left, ?Right, ?Table ) */ wikitext text/x-wiki __NOTOC__ ==Problem Definition== We are given 12 apparently identical coins - one of which is counterfeit. We know that the counterfeit has a different weight from the others, but we don't know if it's heavier or lighter. ===Task:=== Devise a procedure to identify any counterfeit coin using a balance to take up to three comparative weighings. ==Strategy== The information from three suitable weighings will make all but one of the coins, which are untested initially, known_true. There are three alternative deductions that make a coin known_true: * if it is not_heavy and not_light &ndash; having been on both the comparatively lighter and heavier sides of imbalances; * if it was excluded from an imbalance; * if it was included in a balanced weighing. After three weighings there must be exactly one coin, the counterfeit, which is not known_true. If the counterfeit is not known_true and not_heavy we deduce that it must be light. If it is not known_true and not_light, it must be heavy. We use a generate-and-test method as follows: * Create the set of all possible counterfeits: 12 coins &times; 2 weights ; * Devise a procedure that can identify the first counterfeit coin; * Show that the same procedure works for every other counterfeit coin. ==Entry Point== ====go==== is the entry point. It solves the puzzle, then uses a DCG to pretty-print the resulting procedure. <syntaxhighlight lang="prolog"> go :- coins_puzzle( Procedure ), phrase( general_explanation( Procedure ), Chars ), put_chars( Chars ). </syntaxhighlight> ====coins_puzzle( ?Procedure )==== generates the set of all possible counterfeit coins and finds, or proves, that <var>Procedure</var> can identify them all. <syntaxhighlight lang="prolog"> coins_puzzle( Procedure ) :- coins( Coins ), counterfeit( Counterfeit, Coin, Weight ), findall( Counterfeit, (member(Coin,Coins), counterfeit_weight(Weight)), Counterfeits ), coins_puzzle_solution( Counterfeits, Procedure ). coins_puzzle_solution( [], _Procedure ). coins_puzzle_solution( [Counterfeit|Counterfeits], Procedure ) :- solve_coins( Counterfeit, Procedure ), coins_puzzle_solution( Counterfeits, Procedure ). </syntaxhighlight> A procedure is either &lsquo;done&rsquo;, identifying a particular coin and whether it is heavy or light; or it is a &lsquo;step&rsquo;. A step defines the coins to be placed on the <var>Left</var> and <var>Right</var> pans, with the residue remaining on the <var>Table</var>, and three <var>Branches</var>, one of which will be chosen depending on the outcome of the weighing. <syntaxhighlight lang="prolog"> step( step(Left,Right,Table,Branches), Left, Right, Table, Branches). </syntaxhighlight> The <var>Branches</var> are three procedures equating to: * > (left pan heavier), * < (right pan heavier) and * <nowiki>= (pans balance).</nowiki> <syntaxhighlight lang="prolog"> branch( >, branches(_Equal, GT, _LT), GT ). branch( <, branches(_Equal, _GT, LT), LT ). branch( =, branches(Equal, _GT, _LT), Equal ). </syntaxhighlight> The counterfeit is defined by its number and whether it is heavy or light. <syntaxhighlight lang="prolog"> counterfeit( counterfeit(Coin, HeavyOrLight), Coin, HeavyOrLight ). coins( [1,2,3,4,5,6,7,8,9,10,11,12] ). counterfeit_weight( heavy ). counterfeit_weight( light ). </syntaxhighlight> A &lsquo;coin collection&rsquo; comprises four &lsquo;parts&rsquo; (subsets): the <code>known_true</code>, <code>not_heavy</code>, <code>not_light</code> and <code>untested</code> sets of coins. <syntaxhighlight lang="prolog"> part( known_true, collection(Coins,_,_,_), Coins ). part( not_heavy, collection(_,Coins,_,_), Coins ). part( not_light, collection(_,_,Coins,_), Coins ). part( untested, collection(_,_,_,Coins), Coins ). </syntaxhighlight> ==Solution== ====solve_coins( +Counterfeit, ?Procedure )==== holds when <var>Procedure</var> can correctly identify the <var>Counterfeit</var> coin. Beginning with a &lsquo;start&rsquo; collection, in which all the coins are untested, the <var>Procedure</var> comprises three &lsquo;steps&rsquo;. For each step, a weighing is made and a &lsquo;branch&rsquo; is made in the <var>Procedure</var>, depending on the result of the weighing. After three steps, the <var>Procedure</var> must have reached the &lsquo;end&rsquo; condition. Finally, an assertion (redundant test) ensures that the <var>Procedure</var> has found the correct end condition. <syntaxhighlight lang="prolog"> solve_coins( Counterfeit, Procedure ) :- start( Coins0 ), assay( Counterfeit, Coins0, Procedure, Branch1, Coins1 ), assay( Counterfeit, Coins1, Branch1, Branch2, Coins2 ), assay( Counterfeit, Coins2, Branch2, done(Coin, HeavyOrLight), Coins3 ), end( Coins3, Coin, HeavyOrLight ), counterfeit( Counterfeit, Coin, HeavyOrLight ). start( Coins ) :- coins( Untested ), part( untested, Coins, Untested ), part( not_heavy, Coins, [] ), part( not_light, Coins, [] ), part( known_true, Coins, [] ). end( Coins, Coin, HeavyOrLight ) :- part( untested, Coins, [] ), part( not_heavy, Coins, Light ), part( not_light, Coins, Heavy ), end_result( Heavy, Light, Coin, HeavyOrLight ). end_result( [Coin], [], Coin, heavy ). end_result( [], [Coin], Coin, light ). </syntaxhighlight> === Simulating the weighing process === ====assay( +Counterfeit, +Coins0, ?Step, ?Branch, ?Coins1 )==== holds when the appropriate <var>Branch</var> from <var>Step</var> is chosen by comparing the weights of two coin collections taken from the full set of coins: <var>Coins0</var>. <var>Coins1</var> is the full set of coins, updated with the inferences drawn from the weighing. <var>Counterfeit</var> is used to determine the result of the weighing. This predicate applies the critical insight into the solution of this puzzle: we have 24 (12 &times; 2) possible inputs to the procedure, with only 27 (3 &times; 3 &times; 3) possible outcomes from the weighings. Therefore, it is clear that each weighing must have a very high [[#Information Content|information content]]. Choosing which weighing to make by estimating the available information content makes the problem tractable. <syntaxhighlight lang="prolog"> assay( Counterfeit, Coins0, Step, Branch, Coins ) :- WeighingDatum = weighing_data(InfoContent, Left, Right, Table), step( Step, Left, Right, Table, Branches ), findall( WeighingDatum, valid_partition( Coins0, InfoContent, Left, Right, Table ), WeighingData ), sort( WeighingData, OrderedWeighingData ), member( WeighingDatum, OrderedWeighingData ), balance( Left, Right, Counterfeit, Result ), draw_inferences( Result, Left, Right, Table, Coins ), branch( Result, Branches, Branch ). </syntaxhighlight> ====balance( +Left, +Right, +Counterfeit, ?Result )==== holds when <var>Result</var> simulates the outcome of testing the coin collections <var>Left</var> and <var>Right</var> with a balance, where either may contain the <var>Counterfeit</var> coin. <syntaxhighlight lang="prolog"> balance( Left, Right, Counterfeit, Result ):- counterfeit( Counterfeit, Coin, Weight ), ( contains_coin( Left, Coin ) -> balance_result( Weight, normal, Result ) ; contains_coin( Right, Coin ) -> balance_result( normal, Weight, Result ) ; otherwise -> Result = '=' ). balance_result( light, normal, < ). balance_result( heavy, normal, > ). balance_result( normal, heavy, < ). balance_result( normal, light, > ). </syntaxhighlight> ===Choosing which coins to weigh=== ====valid_partition( +Coins, ?Content, ?Left, ?Right, ?Table )==== holds when <var>Coins</var> can be partitioned into three collections: <var>Left</var> side, <var>Right</var> side and <var>Table</var>; with the information content of the partition given by <var>Content</var>. The definition of a valid_partition ensures that: * <var>Left</var> and <var>Right</var> must have the same number of coins (at least one); * <var>Left</var> cannot contain any known_true coins, because adding true coins to both sides creates redundant comparisons; * Comparisons where only the choice of pans is different are equivalent, so a partial order (&ge;) on mixtures of coins is used to eliminate some redundant comparisons. <syntaxhighlight lang="prolog"> valid_partition( Coins, Content, Left, Right, Table ):- part( known_true, Left, [] ), selection( Coins, Left, Coins1, LeftSum, LeftInfo ), selection( Coins1, Right, Table, RightSum, RightInfo ), LeftSum =:= RightSum, LeftSum @>= RightSum, table_information( Table, TableInfo ), sum( [LeftInfo,RightInfo,TableInfo], Content ). </syntaxhighlight> ====selection( +Coins, ?Sample, ?Residue, ?Sum, ?Content )==== holds when <var>Coins</var> is partitioned into two collections: <var>Sample</var> and <var>Residue</var>. <var>Sum</var> is used as both a fingerprint for the mixture of coins in <var>Sample</var> and a representation of the number of coins in <var>Sample</var>. <var>Content</var> estimates the information-content of <var>Sample</var>. <syntaxhighlight lang="prolog"> selection( Coins, Sample, Residue, Sum, Content ) :- Sum = Count1+Count2+Count3+Count4, select_coins( not_heavy, Coins, Sample, Residue, Count1 ), select_coins( not_light, Coins, Sample, Residue, Count2 ), select_coins( untested, Coins, Sample, Residue, Count3 ), select_coins( known_true, Coins, Sample, Residue, Count4 ), Sum >= 1, Sum =< 6, information_content( [Count1,Count2,Count3,Count4], Content ). </syntaxhighlight> ====table_information( +Coins, ?Content )==== holds when <var>Coins</var> has 'information content' <var>Content</var>. <syntaxhighlight lang="prolog"> table_information( Coins, Content ) :- count_coins( not_heavy, Coins, Count1 ), count_coins( not_light, Coins, Count2 ), count_coins( untested, Coins, Count3 ), count_coins( known_true, Coins, Count4 ), information_content( [Count1,Count2,Count3,Count4], Content ). count_coins( Part, Coins, Count ) :- part( Part, Coins, Selection ), length( Selection, Count ). </syntaxhighlight> === Updating what is known about the coins === ====draw_inferences( +Result, +Left, +Right, +Table, ?Coins )==== holds when <var>Result</var> is one of: * > (imbalance &ndash; left pan heavier), * < (imbalance &ndash; right pan heavier) or * <nowiki>=</nowiki> (pans balanced) from taking a weighing with the coin collections: <var>Left</var>, <var>Right</var> and <var>Table</var>. <var>Coins</var> is derived from this information using the following rules: * If the pans are unbalanced then only the previously untested or not_heavy coins on the lighter side of the balance are now not_heavy. Similarly, only the previously untested or not_light coins on the heavier side of the balance are now not_light. All the coins on the table are now known_true. * If the pans balance then all the coins weighed are known_true, with the coins on the <var>Table</var> left in their prior states. <syntaxhighlight lang="prolog"> draw_inferences( <, Left, Right, Table, Coins ) :- imbalance_inferences( Left, Right, Table, Coins ). draw_inferences( >, Left, Right, Table, Coins ) :- imbalance_inferences( Right, Left, Table, Coins ). draw_inferences( =, Left, Right, Table, Coins ) :- becomes( [all(Left),known_true(Table),all(Right)], known_true( Coins ) ), becomes( untested(Table), untested(Coins) ), becomes( not_heavy(Table), not_heavy(Coins) ), becomes( not_light(Table), not_light(Coins) ). </syntaxhighlight> ====imbalance_inferences( +Lighter, +Heavier, +Table, ?Coins )==== holds when: * Only the untested or not_heavy coins in <var>Lighter</var> are not_heavy in <var>Coins</var>; * Only the untested or not_light coins in <var>Heavier</var> are not_light in <var>Coins</var>; * All the other coins in <var>Lighter</var> and <var>Heavier</var> and all the coins in <var>Table</var> are known_true in <var>Coins</var>; There are no untested coins in <var>Coins</var>. <syntaxhighlight lang="prolog"> imbalance_inferences( Lighter, Heavier, Table, Coins ) :- becomes( [untested(Lighter),not_heavy(Lighter)], not_heavy(Coins) ), becomes( [untested(Heavier),not_light(Heavier)], not_light(Coins) ), becomes( [ known_true(Lighter), not_light(Lighter), known_true(Heavier), not_heavy(Heavier), all(Table) ], known_true(Coins) ), part( untested, Coins, [] ). </syntaxhighlight> ====becomes( +CollectionA, ?CollectionB )==== <var>CollectionA</var> becomes (part) <var>CollectionB</var> when <var>CollectionB</var> comprises the same coins as <var>CollectionA</var>. <syntaxhighlight lang="prolog"> becomes( CollectionA, CollectionB ) :- unfolded( CollectionA, Coins ), unfolded( CollectionB, Coins ). </syntaxhighlight> ====unfolded( +Collection, ?Coins )==== holds when (part) <var>Collection</var> comprises <var>Coins</var>. <syntaxhighlight lang="prolog"> unfolded( not_light(Collection), Coins ) :- part( not_light, Collection, Coins ). unfolded( not_heavy(Collection), Coins ) :- part( not_heavy, Collection, Coins ). unfolded( known_true(Collection), Coins ) :- part( known_true, Collection, Coins ). unfolded( untested(Collection), Coins ) :- part( untested, Collection, Coins ). unfolded( all(Collection), Coins ) :- collection_to_set( Collection, Coins ). unfolded( [Item|Items], Coins ) :- unfolded( Item, Value ), unfolded1( Items, Value, Coins ). unfolded1( [], Coins, Coins ). unfolded1( [Item|Items], Value, Coins ) :- unfolded( Item, Value0 ), ord_union( Value0, Value, Value1 ), unfolded1( Items, Value1, Coins ). </syntaxhighlight> ==Definite Clause Grammar== The following DCG represents the method for finding the counterfeit coin as a structured procedure. <syntaxhighlight lang="prolog"> general_explanation( Procedure ) --> "Number the coins 1..12", newline, explanation( Procedure, 0 ). explanation( done(Coin, Weight), N ) --> tab( N ), "Conclude that the counterfeit coin is number ", literal( Coin ), ", which is ", literal( Weight ), newline. explanation( Step, N ) --> {step( Step, Left, Right, Table, Branches )}, tab( N ), "BEGIN", newline, tab( N ), "Put ", literal( Left ), " on the left-hand pan", newline, tab( N ), "Put ", literal( Right ), " on the right-hand pan", newline, tab( N ), "Leaving ", literal( Table ), " on the table", newline, branches_explained( Branches, N ), tab( N ), "END", newline. branches_explained( Branches, N ) --> next_step_explained( <, Branches, N ), next_step_explained( >, Branches, N ), next_step_explained( =, Branches, N ). next_step_explained( Result, Branch, N ) --> {branch( Result, Branch, Step )}, ( {var(Step)} -> "" | {nonvar(Step)} -> tab( N ), "If the ", literal( Result ), " then:", newline, explanation( Step, s(N) ) ). literal( 0 ) --> "0". literal( 1 ) --> "1". literal( 2 ) --> "2". literal( 3 ) --> "3". literal( 4 ) --> "4". literal( 5 ) --> "5". literal( 6 ) --> "6". literal( 7 ) --> "7". literal( 8 ) --> "8". literal( 9 ) --> "9". literal( 10 ) --> "10". literal( 11 ) --> "11". literal( 12 ) --> "12". literal( true ) --> "true". literal( heavy ) --> "heavy". literal( light ) --> "light". literal( = ) --> "pans balance". literal( < ) --> "right-hand pan is heavier". literal( > ) --> "left-hand pan is heavier". literal( Collection ) --> {collection_to_set( Collection , [H|T] )}, literal_set( T, H ). literal_set( [], Number ) --> "the coin numbered ", literal( Number ). literal_set( [H|T], Number ) --> "the coins numbered ", literal( Number ), literal_set1( T, H ). literal_set1( [], Number ) --> " and ", literal( Number ). literal_set1( [H|T], Number ) --> ", ", literal( Number ), literal_set1( T, H ). tab( 0 ) --> "". tab( s(N) ) --> " ", tab( N ). newline --> " ". </syntaxhighlight> ===Utility Predicates=== ====contains_coin( ?Collection, ?Coin )==== holds when <var>Coin</var> is a member of <var>Collection</var>. <syntaxhighlight lang="prolog"> contains_coin( Collection, Coin ) :- part( _Part, Collection, Coins ), member( Coin, Coins ). </syntaxhighlight> ====collection_to_set( +Collection, ?Set )==== holds when <var>Set</var> is the distributed union of the <code>known_true</code>, <code>not_heavy</code>, <code>not_light</code> and <code>untested</code> ordsets comprising <var>Collection</var>. <syntaxhighlight lang="prolog"> collection_to_set( Collection, Set ) :- part( known_true, Collection, KnownTrue ), part( not_heavy, Collection, NotHeavy ), part( not_light, Collection, NotLight ), part( untested, Collection, Untested ), ord_union( [KnownTrue,NotHeavy,NotLight,Untested], Set ). </syntaxhighlight> ===Information Content=== ==== information_content( +Counts, ?Content ) ==== holds when <var>Content</var> is the cumulative negative entropy of <var>Counts</var>. A reduction in entropy equates to a gain in information. <syntaxhighlight lang="prolog"> information_content( Counts, Content ) :- information_content1( Counts, 0, Content ). information_content1( [], Content, Content ). information_content1( [Count|Counts], Content0, Content ):- coins_entropy( Count, Entropy ), Content1 is Content0-Entropy, information_content1( Counts, Content1, Content ). </syntaxhighlight> ==== coins_entropy( ?N, ?Entropy ) ==== holds when <var>Entropy</var> estimates the entropy of a sample of <var>N</var> coins. <var>Entropy</var> = P log₂(¹&frasl;_P), where P = <var>N</var>&divide;12. <syntaxhighlight lang="prolog"> coins_entropy( 0, 0.0 ). coins_entropy( 1, 0.2987 ). coins_entropy( 2, 0.4308 ). coins_entropy( 3, 0.5 ). coins_entropy( 4, 0.5283 ). coins_entropy( 5, 0.5263 ). coins_entropy( 6, 0.5 ). coins_entropy( 7, 0.4536 ). coins_entropy( 8, 0.39 ). coins_entropy( 9, 0.3113 ). coins_entropy( 10, 0.2192 ). coins_entropy( 11, 0.1151 ). coins_entropy( 12, 0.0 ). </syntaxhighlight> ====select_coins( +Part, +Coins, ?Sample, ?Residue, ?N )==== holds when <var>N</var> coins from <var>Part</var> of <var>Coins</var> form <var>Part</var> of <var>Sample</var>, with the remainder forming <var>Part</var> of <var>Residue</var>. <syntaxhighlight lang="prolog"> select_coins( Part, Coins, Sample, Residue, Count ) :- part( Part, Coins, Input ), part( Part, Sample, Selection ), part( Part, Residue, Remainder ), select_n( Count, Input, Selection, Remainder ). select_n( 0, In, [], In ). select_n( 1, [A|Suffix], [A], Suffix ). select_n( 2, [A,B|Suffix], [A,B], Suffix ). select_n( 3, [A,B,C|Suffix], [A,B,C], Suffix ). select_n( 4, [A,B,C,D|Suffix], [A,B,C,D], Suffix ). select_n( 5, [A,B,C,D,E|Suffix], [A,B,C,D,E], Suffix ). select_n( 6, [A,B,C,D,E,F|Suffix], [A,B,C,D,E,F], Suffix ). </syntaxhighlight> Load a small library of [[Puzzle Utilities]]. <syntaxhighlight lang="prolog"> :- ensure_loaded( misc ). </syntaxhighlight> Use the ordsets library. <syntaxhighlight lang="prolog"> :- use_module( library(ordsets), [ord_union/2,ord_union/3] ). </syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/download/counterfeit.txt here]. ==Output== <div class="result"> Number the coins 1..12 BEGIN Put the coins numbered 1, 2, 3 and 4 on the left-hand pan Put the coins numbered 5, 6, 7 and 8 on the right-hand pan Leaving the coins numbered 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 1, 2, 5 and 6 on the left-hand pan Put the coins numbered 3, 7, 9 and 10 on the right-hand pan Leaving the coins numbered 4, 8, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 1 and 7 on the left-hand pan Put the coins numbered 3 and 4 on the right-hand pan Leaving the coins numbered 2, 5, 6, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 1, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 7, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 2, which is light END If the left-hand pan is heavier then: BEGIN Put the coins numbered 3 and 5 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 4, 6, 7, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 3, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 5, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 6, which is heavy END If the pans balance then: BEGIN Put the coins numbered 4 and 8 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 3, 5, 6, 7, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 4, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 8, which is heavy END END If the left-hand pan is heavier then: BEGIN Put the coins numbered 1, 2, 5 and 6 on the left-hand pan Put the coins numbered 3, 7, 9 and 10 on the right-hand pan Leaving the coins numbered 4, 8, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 3 and 5 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 4, 6, 7, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 5, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 3, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 6, which is light END If the left-hand pan is heavier then: BEGIN Put the coins numbered 1 and 7 on the left-hand pan Put the coins numbered 3 and 4 on the right-hand pan Leaving the coins numbered 2, 5, 6, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 7, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 1, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 2, which is heavy END If the pans balance then: BEGIN Put the coins numbered 4 and 8 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 3, 5, 6, 7, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 8, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 4, which is heavy END END If the pans balance then: BEGIN Put the coins numbered 9, 10 and 11 on the left-hand pan Put the coins numbered 1, 2 and 3 on the right-hand pan Leaving the coins numbered 4, 5, 6, 7, 8 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coin numbered 9 on the left-hand pan Put the coin numbered 10 on the right-hand pan Leaving the coins numbered 1, 2, 3, 4, 5, 6, 7, 8, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 9, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 10, which is light If the pans balance then: Conclude that the counterfeit coin is number 11, which is light END If the left-hand pan is heavier then: BEGIN Put the coin numbered 9 on the left-hand pan Put the coin numbered 10 on the right-hand pan Leaving the coins numbered 1, 2, 3, 4, 5, 6, 7, 8, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 10, which is heavy If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 9, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 11, which is heavy END If the pans balance then: BEGIN Put the coin numbered 12 on the left-hand pan Put the coin numbered 1 on the right-hand pan Leaving the coins numbered 2, 3, 4, 5, 6, 7, 8, 9, 10 and 11 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 12, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 12, which is heavy END END END </div> ---- ec3a9a00455b95991e5820a375752964dd8aa4fc 140 139 2015-10-25T11:52:24Z John 2 /* valid_partition( +Coins, ?Content, ?Left, ?Right, ?Table ) */ wikitext text/x-wiki __NOTOC__ ==Problem Definition== We are given 12 apparently identical coins - one of which is counterfeit. We know that the counterfeit has a different weight from the others, but we don't know if it's heavier or lighter. ===Task:=== Devise a procedure to identify any counterfeit coin using a balance to take up to three comparative weighings. ==Strategy== The information from three suitable weighings will make all but one of the coins, which are untested initially, known_true. There are three alternative deductions that make a coin known_true: * if it is not_heavy and not_light &ndash; having been on both the comparatively lighter and heavier sides of imbalances; * if it was excluded from an imbalance; * if it was included in a balanced weighing. After three weighings there must be exactly one coin, the counterfeit, which is not known_true. If the counterfeit is not known_true and not_heavy we deduce that it must be light. If it is not known_true and not_light, it must be heavy. We use a generate-and-test method as follows: * Create the set of all possible counterfeits: 12 coins &times; 2 weights ; * Devise a procedure that can identify the first counterfeit coin; * Show that the same procedure works for every other counterfeit coin. ==Entry Point== ====go==== is the entry point. It solves the puzzle, then uses a DCG to pretty-print the resulting procedure. <syntaxhighlight lang="prolog"> go :- coins_puzzle( Procedure ), phrase( general_explanation( Procedure ), Chars ), put_chars( Chars ). </syntaxhighlight> ====coins_puzzle( ?Procedure )==== generates the set of all possible counterfeit coins and finds, or proves, that <var>Procedure</var> can identify them all. <syntaxhighlight lang="prolog"> coins_puzzle( Procedure ) :- coins( Coins ), counterfeit( Counterfeit, Coin, Weight ), findall( Counterfeit, (member(Coin,Coins), counterfeit_weight(Weight)), Counterfeits ), coins_puzzle_solution( Counterfeits, Procedure ). coins_puzzle_solution( [], _Procedure ). coins_puzzle_solution( [Counterfeit|Counterfeits], Procedure ) :- solve_coins( Counterfeit, Procedure ), coins_puzzle_solution( Counterfeits, Procedure ). </syntaxhighlight> A procedure is either &lsquo;done&rsquo;, identifying a particular coin and whether it is heavy or light; or it is a &lsquo;step&rsquo;. A step defines the coins to be placed on the <var>Left</var> and <var>Right</var> pans, with the residue remaining on the <var>Table</var>, and three <var>Branches</var>, one of which will be chosen depending on the outcome of the weighing. <syntaxhighlight lang="prolog"> step( step(Left,Right,Table,Branches), Left, Right, Table, Branches). </syntaxhighlight> The <var>Branches</var> are three procedures equating to: * > (left pan heavier), * < (right pan heavier) and * <nowiki>= (pans balance).</nowiki> <syntaxhighlight lang="prolog"> branch( >, branches(_Equal, GT, _LT), GT ). branch( <, branches(_Equal, _GT, LT), LT ). branch( =, branches(Equal, _GT, _LT), Equal ). </syntaxhighlight> The counterfeit is defined by its number and whether it is heavy or light. <syntaxhighlight lang="prolog"> counterfeit( counterfeit(Coin, HeavyOrLight), Coin, HeavyOrLight ). coins( [1,2,3,4,5,6,7,8,9,10,11,12] ). counterfeit_weight( heavy ). counterfeit_weight( light ). </syntaxhighlight> A &lsquo;coin collection&rsquo; comprises four &lsquo;parts&rsquo; (subsets): the <code>known_true</code>, <code>not_heavy</code>, <code>not_light</code> and <code>untested</code> sets of coins. <syntaxhighlight lang="prolog"> part( known_true, collection(Coins,_,_,_), Coins ). part( not_heavy, collection(_,Coins,_,_), Coins ). part( not_light, collection(_,_,Coins,_), Coins ). part( untested, collection(_,_,_,Coins), Coins ). </syntaxhighlight> ==Solution== ====solve_coins( +Counterfeit, ?Procedure )==== holds when <var>Procedure</var> can correctly identify the <var>Counterfeit</var> coin. Beginning with a &lsquo;start&rsquo; collection, in which all the coins are untested, the <var>Procedure</var> comprises three &lsquo;steps&rsquo;. For each step, a weighing is made and a &lsquo;branch&rsquo; is made in the <var>Procedure</var>, depending on the result of the weighing. After three steps, the <var>Procedure</var> must have reached the &lsquo;end&rsquo; condition. Finally, an assertion (redundant test) ensures that the <var>Procedure</var> has found the correct end condition. <syntaxhighlight lang="prolog"> solve_coins( Counterfeit, Procedure ) :- start( Coins0 ), assay( Counterfeit, Coins0, Procedure, Branch1, Coins1 ), assay( Counterfeit, Coins1, Branch1, Branch2, Coins2 ), assay( Counterfeit, Coins2, Branch2, done(Coin, HeavyOrLight), Coins3 ), end( Coins3, Coin, HeavyOrLight ), counterfeit( Counterfeit, Coin, HeavyOrLight ). start( Coins ) :- coins( Untested ), part( untested, Coins, Untested ), part( not_heavy, Coins, [] ), part( not_light, Coins, [] ), part( known_true, Coins, [] ). end( Coins, Coin, HeavyOrLight ) :- part( untested, Coins, [] ), part( not_heavy, Coins, Light ), part( not_light, Coins, Heavy ), end_result( Heavy, Light, Coin, HeavyOrLight ). end_result( [Coin], [], Coin, heavy ). end_result( [], [Coin], Coin, light ). </syntaxhighlight> === Simulating the weighing process === ====assay( +Counterfeit, +Coins0, ?Step, ?Branch, ?Coins1 )==== holds when the appropriate <var>Branch</var> from <var>Step</var> is chosen by comparing the weights of two coin collections taken from the full set of coins: <var>Coins0</var>. <var>Coins1</var> is the full set of coins, updated with the inferences drawn from the weighing. <var>Counterfeit</var> is used to determine the result of the weighing. This predicate applies the critical insight into the solution of this puzzle: we have 24 (12 &times; 2) possible inputs to the procedure, with only 27 (3 &times; 3 &times; 3) possible outcomes from the weighings. Therefore, it is clear that each weighing must have a very high [[#Information Content|information content]]. Choosing which weighing to make by estimating the available information content makes the problem tractable. <syntaxhighlight lang="prolog"> assay( Counterfeit, Coins0, Step, Branch, Coins ) :- WeighingDatum = weighing_data(InfoContent, Left, Right, Table), step( Step, Left, Right, Table, Branches ), findall( WeighingDatum, valid_partition( Coins0, InfoContent, Left, Right, Table ), WeighingData ), sort( WeighingData, OrderedWeighingData ), member( WeighingDatum, OrderedWeighingData ), balance( Left, Right, Counterfeit, Result ), draw_inferences( Result, Left, Right, Table, Coins ), branch( Result, Branches, Branch ). </syntaxhighlight> ====balance( +Left, +Right, +Counterfeit, ?Result )==== holds when <var>Result</var> simulates the outcome of testing the coin collections <var>Left</var> and <var>Right</var> with a balance, where either may contain the <var>Counterfeit</var> coin. <syntaxhighlight lang="prolog"> balance( Left, Right, Counterfeit, Result ):- counterfeit( Counterfeit, Coin, Weight ), ( contains_coin( Left, Coin ) -> balance_result( Weight, normal, Result ) ; contains_coin( Right, Coin ) -> balance_result( normal, Weight, Result ) ; otherwise -> Result = '=' ). balance_result( light, normal, < ). balance_result( heavy, normal, > ). balance_result( normal, heavy, < ). balance_result( normal, light, > ). </syntaxhighlight> ===Choosing which coins to weigh=== ====valid_partition( +Coins, ?Content, ?Left, ?Right, ?Table )==== holds when <var>Coins</var> can be partitioned into three collections: <var>Left</var> side, <var>Right</var> side and <var>Table</var>; with the information content of the partition given by <var>Content</var>. The definition of a valid_partition ensures that: * <var>Left</var> and <var>Right</var> must have the same number of coins (at least one); * <var>Left</var> cannot contain any known_true coins, because adding true coins to both sides creates redundant comparisons; * Comparisons between mixtures of coins where only the choice of pans is different are equivalent; so a partial order (&ge;) on mixtures of coins is used to eliminate some redundant comparisons. <syntaxhighlight lang="prolog"> valid_partition( Coins, Content, Left, Right, Table ):- part( known_true, Left, [] ), selection( Coins, Left, Coins1, LeftSum, LeftInfo ), selection( Coins1, Right, Table, RightSum, RightInfo ), LeftSum =:= RightSum, LeftSum @>= RightSum, table_information( Table, TableInfo ), sum( [LeftInfo,RightInfo,TableInfo], Content ). </syntaxhighlight> ====selection( +Coins, ?Sample, ?Residue, ?Sum, ?Content )==== holds when <var>Coins</var> is partitioned into two collections: <var>Sample</var> and <var>Residue</var>. <var>Sum</var> is used as both a fingerprint for the mixture of coins in <var>Sample</var> and a representation of the number of coins in <var>Sample</var>. <var>Content</var> estimates the information-content of <var>Sample</var>. <syntaxhighlight lang="prolog"> selection( Coins, Sample, Residue, Sum, Content ) :- Sum = Count1+Count2+Count3+Count4, select_coins( not_heavy, Coins, Sample, Residue, Count1 ), select_coins( not_light, Coins, Sample, Residue, Count2 ), select_coins( untested, Coins, Sample, Residue, Count3 ), select_coins( known_true, Coins, Sample, Residue, Count4 ), Sum >= 1, Sum =< 6, information_content( [Count1,Count2,Count3,Count4], Content ). </syntaxhighlight> ====table_information( +Coins, ?Content )==== holds when <var>Coins</var> has 'information content' <var>Content</var>. <syntaxhighlight lang="prolog"> table_information( Coins, Content ) :- count_coins( not_heavy, Coins, Count1 ), count_coins( not_light, Coins, Count2 ), count_coins( untested, Coins, Count3 ), count_coins( known_true, Coins, Count4 ), information_content( [Count1,Count2,Count3,Count4], Content ). count_coins( Part, Coins, Count ) :- part( Part, Coins, Selection ), length( Selection, Count ). </syntaxhighlight> === Updating what is known about the coins === ====draw_inferences( +Result, +Left, +Right, +Table, ?Coins )==== holds when <var>Result</var> is one of: * > (imbalance &ndash; left pan heavier), * < (imbalance &ndash; right pan heavier) or * <nowiki>=</nowiki> (pans balanced) from taking a weighing with the coin collections: <var>Left</var>, <var>Right</var> and <var>Table</var>. <var>Coins</var> is derived from this information using the following rules: * If the pans are unbalanced then only the previously untested or not_heavy coins on the lighter side of the balance are now not_heavy. Similarly, only the previously untested or not_light coins on the heavier side of the balance are now not_light. All the coins on the table are now known_true. * If the pans balance then all the coins weighed are known_true, with the coins on the <var>Table</var> left in their prior states. <syntaxhighlight lang="prolog"> draw_inferences( <, Left, Right, Table, Coins ) :- imbalance_inferences( Left, Right, Table, Coins ). draw_inferences( >, Left, Right, Table, Coins ) :- imbalance_inferences( Right, Left, Table, Coins ). draw_inferences( =, Left, Right, Table, Coins ) :- becomes( [all(Left),known_true(Table),all(Right)], known_true( Coins ) ), becomes( untested(Table), untested(Coins) ), becomes( not_heavy(Table), not_heavy(Coins) ), becomes( not_light(Table), not_light(Coins) ). </syntaxhighlight> ====imbalance_inferences( +Lighter, +Heavier, +Table, ?Coins )==== holds when: * Only the untested or not_heavy coins in <var>Lighter</var> are not_heavy in <var>Coins</var>; * Only the untested or not_light coins in <var>Heavier</var> are not_light in <var>Coins</var>; * All the other coins in <var>Lighter</var> and <var>Heavier</var> and all the coins in <var>Table</var> are known_true in <var>Coins</var>; There are no untested coins in <var>Coins</var>. <syntaxhighlight lang="prolog"> imbalance_inferences( Lighter, Heavier, Table, Coins ) :- becomes( [untested(Lighter),not_heavy(Lighter)], not_heavy(Coins) ), becomes( [untested(Heavier),not_light(Heavier)], not_light(Coins) ), becomes( [ known_true(Lighter), not_light(Lighter), known_true(Heavier), not_heavy(Heavier), all(Table) ], known_true(Coins) ), part( untested, Coins, [] ). </syntaxhighlight> ====becomes( +CollectionA, ?CollectionB )==== <var>CollectionA</var> becomes (part) <var>CollectionB</var> when <var>CollectionB</var> comprises the same coins as <var>CollectionA</var>. <syntaxhighlight lang="prolog"> becomes( CollectionA, CollectionB ) :- unfolded( CollectionA, Coins ), unfolded( CollectionB, Coins ). </syntaxhighlight> ====unfolded( +Collection, ?Coins )==== holds when (part) <var>Collection</var> comprises <var>Coins</var>. <syntaxhighlight lang="prolog"> unfolded( not_light(Collection), Coins ) :- part( not_light, Collection, Coins ). unfolded( not_heavy(Collection), Coins ) :- part( not_heavy, Collection, Coins ). unfolded( known_true(Collection), Coins ) :- part( known_true, Collection, Coins ). unfolded( untested(Collection), Coins ) :- part( untested, Collection, Coins ). unfolded( all(Collection), Coins ) :- collection_to_set( Collection, Coins ). unfolded( [Item|Items], Coins ) :- unfolded( Item, Value ), unfolded1( Items, Value, Coins ). unfolded1( [], Coins, Coins ). unfolded1( [Item|Items], Value, Coins ) :- unfolded( Item, Value0 ), ord_union( Value0, Value, Value1 ), unfolded1( Items, Value1, Coins ). </syntaxhighlight> ==Definite Clause Grammar== The following DCG represents the method for finding the counterfeit coin as a structured procedure. <syntaxhighlight lang="prolog"> general_explanation( Procedure ) --> "Number the coins 1..12", newline, explanation( Procedure, 0 ). explanation( done(Coin, Weight), N ) --> tab( N ), "Conclude that the counterfeit coin is number ", literal( Coin ), ", which is ", literal( Weight ), newline. explanation( Step, N ) --> {step( Step, Left, Right, Table, Branches )}, tab( N ), "BEGIN", newline, tab( N ), "Put ", literal( Left ), " on the left-hand pan", newline, tab( N ), "Put ", literal( Right ), " on the right-hand pan", newline, tab( N ), "Leaving ", literal( Table ), " on the table", newline, branches_explained( Branches, N ), tab( N ), "END", newline. branches_explained( Branches, N ) --> next_step_explained( <, Branches, N ), next_step_explained( >, Branches, N ), next_step_explained( =, Branches, N ). next_step_explained( Result, Branch, N ) --> {branch( Result, Branch, Step )}, ( {var(Step)} -> "" | {nonvar(Step)} -> tab( N ), "If the ", literal( Result ), " then:", newline, explanation( Step, s(N) ) ). literal( 0 ) --> "0". literal( 1 ) --> "1". literal( 2 ) --> "2". literal( 3 ) --> "3". literal( 4 ) --> "4". literal( 5 ) --> "5". literal( 6 ) --> "6". literal( 7 ) --> "7". literal( 8 ) --> "8". literal( 9 ) --> "9". literal( 10 ) --> "10". literal( 11 ) --> "11". literal( 12 ) --> "12". literal( true ) --> "true". literal( heavy ) --> "heavy". literal( light ) --> "light". literal( = ) --> "pans balance". literal( < ) --> "right-hand pan is heavier". literal( > ) --> "left-hand pan is heavier". literal( Collection ) --> {collection_to_set( Collection , [H|T] )}, literal_set( T, H ). literal_set( [], Number ) --> "the coin numbered ", literal( Number ). literal_set( [H|T], Number ) --> "the coins numbered ", literal( Number ), literal_set1( T, H ). literal_set1( [], Number ) --> " and ", literal( Number ). literal_set1( [H|T], Number ) --> ", ", literal( Number ), literal_set1( T, H ). tab( 0 ) --> "". tab( s(N) ) --> " ", tab( N ). newline --> " ". </syntaxhighlight> ===Utility Predicates=== ====contains_coin( ?Collection, ?Coin )==== holds when <var>Coin</var> is a member of <var>Collection</var>. <syntaxhighlight lang="prolog"> contains_coin( Collection, Coin ) :- part( _Part, Collection, Coins ), member( Coin, Coins ). </syntaxhighlight> ====collection_to_set( +Collection, ?Set )==== holds when <var>Set</var> is the distributed union of the <code>known_true</code>, <code>not_heavy</code>, <code>not_light</code> and <code>untested</code> ordsets comprising <var>Collection</var>. <syntaxhighlight lang="prolog"> collection_to_set( Collection, Set ) :- part( known_true, Collection, KnownTrue ), part( not_heavy, Collection, NotHeavy ), part( not_light, Collection, NotLight ), part( untested, Collection, Untested ), ord_union( [KnownTrue,NotHeavy,NotLight,Untested], Set ). </syntaxhighlight> ===Information Content=== ==== information_content( +Counts, ?Content ) ==== holds when <var>Content</var> is the cumulative negative entropy of <var>Counts</var>. A reduction in entropy equates to a gain in information. <syntaxhighlight lang="prolog"> information_content( Counts, Content ) :- information_content1( Counts, 0, Content ). information_content1( [], Content, Content ). information_content1( [Count|Counts], Content0, Content ):- coins_entropy( Count, Entropy ), Content1 is Content0-Entropy, information_content1( Counts, Content1, Content ). </syntaxhighlight> ==== coins_entropy( ?N, ?Entropy ) ==== holds when <var>Entropy</var> estimates the entropy of a sample of <var>N</var> coins. <var>Entropy</var> = P log₂(¹&frasl;_P), where P = <var>N</var>&divide;12. <syntaxhighlight lang="prolog"> coins_entropy( 0, 0.0 ). coins_entropy( 1, 0.2987 ). coins_entropy( 2, 0.4308 ). coins_entropy( 3, 0.5 ). coins_entropy( 4, 0.5283 ). coins_entropy( 5, 0.5263 ). coins_entropy( 6, 0.5 ). coins_entropy( 7, 0.4536 ). coins_entropy( 8, 0.39 ). coins_entropy( 9, 0.3113 ). coins_entropy( 10, 0.2192 ). coins_entropy( 11, 0.1151 ). coins_entropy( 12, 0.0 ). </syntaxhighlight> ====select_coins( +Part, +Coins, ?Sample, ?Residue, ?N )==== holds when <var>N</var> coins from <var>Part</var> of <var>Coins</var> form <var>Part</var> of <var>Sample</var>, with the remainder forming <var>Part</var> of <var>Residue</var>. <syntaxhighlight lang="prolog"> select_coins( Part, Coins, Sample, Residue, Count ) :- part( Part, Coins, Input ), part( Part, Sample, Selection ), part( Part, Residue, Remainder ), select_n( Count, Input, Selection, Remainder ). select_n( 0, In, [], In ). select_n( 1, [A|Suffix], [A], Suffix ). select_n( 2, [A,B|Suffix], [A,B], Suffix ). select_n( 3, [A,B,C|Suffix], [A,B,C], Suffix ). select_n( 4, [A,B,C,D|Suffix], [A,B,C,D], Suffix ). select_n( 5, [A,B,C,D,E|Suffix], [A,B,C,D,E], Suffix ). select_n( 6, [A,B,C,D,E,F|Suffix], [A,B,C,D,E,F], Suffix ). </syntaxhighlight> Load a small library of [[Puzzle Utilities]]. <syntaxhighlight lang="prolog"> :- ensure_loaded( misc ). </syntaxhighlight> Use the ordsets library. <syntaxhighlight lang="prolog"> :- use_module( library(ordsets), [ord_union/2,ord_union/3] ). </syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/download/counterfeit.txt here]. ==Output== <div class="result"> Number the coins 1..12 BEGIN Put the coins numbered 1, 2, 3 and 4 on the left-hand pan Put the coins numbered 5, 6, 7 and 8 on the right-hand pan Leaving the coins numbered 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 1, 2, 5 and 6 on the left-hand pan Put the coins numbered 3, 7, 9 and 10 on the right-hand pan Leaving the coins numbered 4, 8, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 1 and 7 on the left-hand pan Put the coins numbered 3 and 4 on the right-hand pan Leaving the coins numbered 2, 5, 6, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 1, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 7, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 2, which is light END If the left-hand pan is heavier then: BEGIN Put the coins numbered 3 and 5 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 4, 6, 7, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 3, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 5, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 6, which is heavy END If the pans balance then: BEGIN Put the coins numbered 4 and 8 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 3, 5, 6, 7, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 4, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 8, which is heavy END END If the left-hand pan is heavier then: BEGIN Put the coins numbered 1, 2, 5 and 6 on the left-hand pan Put the coins numbered 3, 7, 9 and 10 on the right-hand pan Leaving the coins numbered 4, 8, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 3 and 5 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 4, 6, 7, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 5, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 3, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 6, which is light END If the left-hand pan is heavier then: BEGIN Put the coins numbered 1 and 7 on the left-hand pan Put the coins numbered 3 and 4 on the right-hand pan Leaving the coins numbered 2, 5, 6, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 7, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 1, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 2, which is heavy END If the pans balance then: BEGIN Put the coins numbered 4 and 8 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 3, 5, 6, 7, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 8, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 4, which is heavy END END If the pans balance then: BEGIN Put the coins numbered 9, 10 and 11 on the left-hand pan Put the coins numbered 1, 2 and 3 on the right-hand pan Leaving the coins numbered 4, 5, 6, 7, 8 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coin numbered 9 on the left-hand pan Put the coin numbered 10 on the right-hand pan Leaving the coins numbered 1, 2, 3, 4, 5, 6, 7, 8, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 9, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 10, which is light If the pans balance then: Conclude that the counterfeit coin is number 11, which is light END If the left-hand pan is heavier then: BEGIN Put the coin numbered 9 on the left-hand pan Put the coin numbered 10 on the right-hand pan Leaving the coins numbered 1, 2, 3, 4, 5, 6, 7, 8, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 10, which is heavy If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 9, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 11, which is heavy END If the pans balance then: BEGIN Put the coin numbered 12 on the left-hand pan Put the coin numbered 1 on the right-hand pan Leaving the coins numbered 2, 3, 4, 5, 6, 7, 8, 9, 10 and 11 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 12, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 12, which is heavy END END END </div> ---- eef76c3d67199f8d93d68821af7f87191917ddf4 0 19 108 77 2015-05-13T09:25:08Z John 2 /* HTTP */ wikitext text/x-wiki __NOTOC__ == Prolog for the Worldwide Web == For a Prolog programmer, to suggest that Prolog is an ideal language for web-based applications is to invite the comment that, &quot;if you have only a hammer, everything looks like a nail&quot;. However, the correspondences between Prolog behaviour and HTTP, and Prolog data-structures and XML are so strong that it's fair to say that ''if Prolog is a hand, the Worldwide Web is a glove.'' == HTTP == Consider that Prolog's default behaviour is query-solving - where a query is posed for which arbitrarily many answers (solutions) may be returned. This can be mapped to HTTP's request/response mechanism straightforwardly: === HTTP GET === The HTTP GET verb has a clear correspondence with Prolog's notion of a query. In fact, Prolog can be used directly as part of a request URI, acting as a lightweight data-structuring mechanism. However, HTTP requires each request/response to be deterministic, which suggests that ''all'' the solutions for a non-deterministic query should be returned. The solutions can be formatted as an XHTML list or table, for example. === Caching === Prolog programming allows for the 'caching' of expensive results using &quot;lemmas&quot;, a technique used in the solution of the [[Mister X#Lemmas|Mister X]] puzzle, for example. HTTP's 'HEAD' verb, (and GET with &quot;If-Modified-Since&quot;) support caching mechanisms, primarily to save communications bandwidth. The integration of Prolog &quot;lemmas&quot; with HTTP's caching methods can save both bandwidth and recomputation through a single mechanism, enabling the creation of robust distributed applications with a minimum of fuss. === HTTP POST === When using Prolog with HTTP, the POST verb should be reserved for passing ''clauses'' from the client to the server, to update the server, not for queries. The fact that Prolog is a good format for including structured (composite) data items as part of a URI can obviate some inappropriate uses of HTTP's POST verb, by allowing more complex terms in GET requests. == XML == HTTP services in which both the client and server are Prolog programs can gain efficiency by exchanging Prolog terms in URIs and results, using Prolog's term I/O facilities. However, XML is becoming established as the preferred format for data exchange in heterogeneous distributed applications. XML data is represented easily in Prolog, and vice versa, because both use tree-structured data exclusively. Because Prolog is a very high-level language, it is more flexible and more powerful than [http://www.w3.org/TR/xslt XSLT]. In particular, it seems to be very much easier to create robust, reliable transformations with Prolog, i.e. ones that produce only valid output for any valid input. ===xml.pl=== xml.pl is a module for [[parsing XML with Prolog]]. It has been placed in the public domain to encourage the use of Prolog with XML. ==PiLLoW== The [http://clip.dia.fi.upm.es/miscdocs/pillow/pillow.html PiLLoW] library provides predicates for developing HTTP client and server applications. For client applications, it provides mechanisms to retrieve HTML files and to parse HTML into useful Prolog terms. For server applications it provides a predicate to access CGI query parameters, so that a Prolog application can be used to handle form input directly i.e. without additional scripting. Additionally, HTML parsing supports the reverse translation of terms into HTML, so that forms can be generated. See also, [[Porting PiLLoW to Quintus Prolog]]. dde2631737a36f974c1bd3e87bb2f1462d78dfce 109 108 2015-05-13T09:26:14Z John 2 /* Prolog for the Worldwide Web */ wikitext text/x-wiki __NOTOC__ == Prolog for the Worldwide Web == For a Prolog programmer, to suggest that Prolog is an ideal language for web-based applications is to invite the comment that, &ldquo;if you have only a hammer, everything looks like a nail&rdquo;. However, the correspondences between Prolog behaviour and HTTP, and Prolog data-structures and XML are so strong that it's fair to say that ''if Prolog is a hand, the Worldwide Web is a glove.'' == HTTP == Consider that Prolog's default behaviour is query-solving - where a query is posed for which arbitrarily many answers (solutions) may be returned. This can be mapped to HTTP's request/response mechanism straightforwardly: === HTTP GET === The HTTP GET verb has a clear correspondence with Prolog's notion of a query. In fact, Prolog can be used directly as part of a request URI, acting as a lightweight data-structuring mechanism. However, HTTP requires each request/response to be deterministic, which suggests that ''all'' the solutions for a non-deterministic query should be returned. The solutions can be formatted as an XHTML list or table, for example. === Caching === Prolog programming allows for the 'caching' of expensive results using &quot;lemmas&quot;, a technique used in the solution of the [[Mister X#Lemmas|Mister X]] puzzle, for example. HTTP's 'HEAD' verb, (and GET with &quot;If-Modified-Since&quot;) support caching mechanisms, primarily to save communications bandwidth. The integration of Prolog &quot;lemmas&quot; with HTTP's caching methods can save both bandwidth and recomputation through a single mechanism, enabling the creation of robust distributed applications with a minimum of fuss. === HTTP POST === When using Prolog with HTTP, the POST verb should be reserved for passing ''clauses'' from the client to the server, to update the server, not for queries. The fact that Prolog is a good format for including structured (composite) data items as part of a URI can obviate some inappropriate uses of HTTP's POST verb, by allowing more complex terms in GET requests. == XML == HTTP services in which both the client and server are Prolog programs can gain efficiency by exchanging Prolog terms in URIs and results, using Prolog's term I/O facilities. However, XML is becoming established as the preferred format for data exchange in heterogeneous distributed applications. XML data is represented easily in Prolog, and vice versa, because both use tree-structured data exclusively. Because Prolog is a very high-level language, it is more flexible and more powerful than [http://www.w3.org/TR/xslt XSLT]. In particular, it seems to be very much easier to create robust, reliable transformations with Prolog, i.e. ones that produce only valid output for any valid input. ===xml.pl=== xml.pl is a module for [[parsing XML with Prolog]]. It has been placed in the public domain to encourage the use of Prolog with XML. ==PiLLoW== The [http://clip.dia.fi.upm.es/miscdocs/pillow/pillow.html PiLLoW] library provides predicates for developing HTTP client and server applications. For client applications, it provides mechanisms to retrieve HTML files and to parse HTML into useful Prolog terms. For server applications it provides a predicate to access CGI query parameters, so that a Prolog application can be used to handle form input directly i.e. without additional scripting. Additionally, HTML parsing supports the reverse translation of terms into HTML, so that forms can be generated. See also, [[Porting PiLLoW to Quintus Prolog]]. c994d7a62097367ccfebec50a3e2a305cd20a0df 115 109 2015-06-01T23:39:57Z John 2 wikitext text/x-wiki __NOTOC__ == Prolog for the Worldwide Web == For a Prolog programmer, to suggest that Prolog is an ideal language for web-based applications is to invite the comment that, &ldquo;if you have only a hammer, everything looks like a nail&rdquo;. However, the correspondences between Prolog behaviour and HTTP, and Prolog data-structures and XML are so strong that it's fair to say that ''if Prolog is a hand, the Worldwide Web is a glove.'' == HTTP == Consider that Prolog's default behaviour is query-solving - where a query is posed for which arbitrarily many answers (solutions) may be returned. This can be mapped to HTTP's request/response mechanism straightforwardly: === HTTP GET === The HTTP GET verb has a clear correspondence with Prolog's notion of a query. In fact, Prolog can be used directly as part of a request-URI, acting as a lightweight data structuring mechanism. However, HTTP requires each request/response to be deterministic, which suggests that ''all'' the solutions for a non-deterministic query should be returned. The solutions can be formatted as an XHTML list or table, for example. === Caching === Prolog programming allows for the 'caching' of expensive results using &quot;lemmas&quot;, a technique used in the solution of the [[Mister X#Lemmas|Mister X]] puzzle, for example. HTTP's 'HEAD' verb, (and GET with &quot;If-Modified-Since&quot;) support caching mechanisms, primarily to save communications bandwidth. The integration of Prolog &quot;lemmas&quot; with HTTP's caching methods can save both bandwidth and recomputation through a single mechanism, enabling the creation of robust distributed applications with a minimum of fuss. === HTTP POST === When using Prolog with HTTP, the POST verb should be reserved for passing ''clauses'' from the client to the server, to update the server, not for queries. The fact that Prolog is a good format for including structured (composite) data items as part of a URI can obviate some inappropriate uses of HTTP's POST verb, by allowing more complex terms in GET requests. == XML == HTTP services in which both the client and server are Prolog programs can gain efficiency by exchanging Prolog terms in URIs and results, using Prolog's term I/O facilities. However, XML is becoming established as the preferred format for data exchange in heterogeneous distributed applications. XML data is represented easily in Prolog, and vice versa, because both use tree-structured data exclusively. Because Prolog is a very high-level language, it is more flexible and more powerful than [http://www.w3.org/TR/xslt XSLT]. In particular, it seems to be very much easier to create robust, reliable transformations with Prolog, i.e. ones that produce only valid output for any valid input. ===xml.pl=== xml.pl is a module for [[parsing XML with Prolog]]. It has been placed in the public domain to encourage the use of Prolog with XML. ==PiLLoW== The [http://clip.dia.fi.upm.es/miscdocs/pillow/pillow.html PiLLoW] library provides predicates for developing HTTP client and server applications. For client applications, it provides mechanisms to retrieve HTML files and to parse HTML into useful Prolog terms. For server applications, it provides a predicate to access CGI query parameters so that a Prolog application can be used to handle form input directly i.e. without additional scripting. Additionally, HTML parsing supports the reverse translation of terms into HTML so that forms can be generated. See also, [[Porting PiLLoW to Quintus Prolog]]. 00c2e1fcf406feab003d15f5e4c11aefa53258db 118 115 2015-06-10T21:57:09Z John 2 wikitext text/x-wiki __NOTOC__ == Prolog for the Worldwide Web == For a Prolog programmer, to suggest that Prolog is an ideal language for web-based applications is to invite the comment that, &ldquo;if you have only a hammer, everything looks like a nail&rdquo;. However, the correspondences between Prolog behaviour and HTTP, and Prolog data-structures and XML are so strong that it's fair to say that ''if Prolog is a hand, the Worldwide Web is a glove.'' == HTTP == Consider that Prolog's default behaviour is query-solving &ndash; where a query is posed for which arbitrarily many answers (solutions) may be returned. This can be mapped to HTTP's request/response mechanism straightforwardly: === HTTP GET === The HTTP GET verb has a clear correspondence with Prolog's notion of a query. In fact, Prolog can be used directly as part of a request URI, acting as a lightweight data structuring mechanism. However, HTTP requires each request/response to be deterministic, which suggests that ''all'' the solutions for a non-deterministic query should be returned. The solutions can be formatted as an XHTML list or table, for example. === Caching === Prolog programming allows for the 'caching' of expensive results using lemmas, a technique used in the solution of the [[Mister X#Lemmas|Mister X]] puzzle, for example. HTTP's 'HEAD' verb and GET with &ldquo;If-Modified-Since&rdquo; support caching mechanisms, primarily to save communications bandwidth. The integration of Prolog lemmas with HTTP's caching methods can save both bandwidth and recomputation through a single mechanism, enabling the creation of robust distributed applications with a minimum of fuss. === HTTP POST === When using Prolog with HTTP, the POST verb should be reserved for passing clauses from the client to the server, to update the server, not for queries. The fact that Prolog is a good format for including structured (composite) data items as part of a URI can obviate some inappropriate uses of HTTP's POST verb, by allowing more complex terms in GET requests. == XML == HTTP services in which both the client and server are Prolog programs can gain efficiency by exchanging Prolog terms in URIs and results, using Prolog's term I/O facilities. However, XML is becoming established as the preferred format for data exchange in heterogeneous distributed applications. XML data is represented easily in Prolog, and vice versa, because both use tree-structured data exclusively. Because Prolog is a very high-level language, it is more flexible and more powerful than [http://www.w3.org/TR/xslt XSLT]. In particular, it seems to be very much easier to create robust and reliable transformations with Prolog, i.e. ones that produce only valid output for any valid input. ===xml.pl=== xml.pl is a module for [[parsing XML with Prolog]]. It has been placed in the public domain to encourage the use of Prolog with XML. ==PiLLoW== The [http://clip.dia.fi.upm.es/miscdocs/pillow/pillow.html PiLLoW] library provides predicates for developing HTTP client and server applications. For client applications, it provides mechanisms to retrieve HTML files and to parse HTML into useful Prolog terms. For server applications, it provides a predicate to access CGI query parameters so that a Prolog application can be used to handle form input directly i.e. without additional scripting. Additionally, HTML parsing supports the reverse translation of terms into HTML so that forms can be generated. See also, [[Porting PiLLoW to Quintus Prolog]]. 607ee4a3016f0725e90b99868b158b2e09743589 0 10 110 84 2015-05-19T23:07:39Z John 2 wikitext text/x-wiki ;Constrained Permutations in Prolog __NOTOC__ Problem posted to [http://groups.google.com/group/comp.lang.prolog/msg/a984ea325e0a4180 comp.lang.prolog] by Daniel Dudley ===Problem Statement=== <blockquote>A university was to hold an examination in 5 subjects: Norwegian, German, English, French and Spanish. In each of these languages there were 4 candidates. The examination room was therefore divided into 20 cells, as shown in the figure below (view this in a fixed font): <pre> X X X X X X X X X X X X X X X X X X X X</pre> The university's administration wanted to secure themselves against cheating. Candidates in the same language were to be completely isolated from each other - so much so that their cells were not to coincide even at the corners. A young lecturer was given the job of finding a solution to the problem, which he did, and justly received a pat on the back from the dean. Now it just so happens that the dean is an ardent prolog programmer in his spare time (how else could he make dean?) and, realizing that there could be several solutions to the problem, used his skills to find all solutions. Can you do the same? </blockquote> ===Note=== &ldquo;Several solutions&rdquo; doesn't really cover it! Assuming that by &lsquo;a solution&rsquo; we mean finding a mapping between candidates and cells, then, having found one such solution, we can easily find 955,514,879 other members of its solution &ldquo;family&rdquo; through: * ''candidate permutation'': There are (4!)⁵ permutations of the candidates within the cells allocated to their subjects; * ''subject permutation'': we can multiply the candidate permutations by the 5! permutations of the subjects allocated to particular sets of cells. This means that the total number of solutions is 955514880 &times; D where D is the number of solution families i.e. solutions that cannot be derived from each other by candidate or subject permutation. Finding [[#Result|D]] is the more interesting problem solved by this program. ====nut1( ?Solutions )==== <var>Solutions</var> is the number of distinct solutions to the subject/cell allocation problem for any five different subjects. <syntaxhighlight lang="prolog">nut1( Solutions ) :- Norwegian = 1, German = 2, English = 3, French = 4, Spanish = 5, candidates( [Norwegian,German,English,French,Spanish], Candidates ), matrix( Cells ), count_solutions( allocate(Cells,Candidates), Solutions ).</syntaxhighlight> ====allocate( +Cells, +Candidates )==== holds when each cell in <var>Cells</var> holds a candidate from <var>Candidates</var>. <syntaxhighlight lang="prolog">allocate( Cells, Candidates ) :- allocation( Cells, 1, Candidates ).</syntaxhighlight> ====allocation( +Cells, +NextSubject, +Subjects )==== holds when <var>Cells</var> is a representation of a distinct solution to the subject/cell allocation problem. <var>NextSubject</var> is the highest subject that can be allocated next, while <var>Subjects</var> is the list of subjects needing allocation to <var>Cells</var>. Each subject is represented by a list, in which each occurrence of the subject number represents a candidate. We guarantee distinct solutions by ensuring that the allocation is made on the following basis: * For each subject: the location of the N+1th candidate must be a successor of the location of the Nth candidate - to eliminate candidate permutations. * The location of the first candidate of the N+1th subject must be a successor of the location of the first candidate of the Nth subject &ndash; to eliminate subject permutations. Operationally, at each step we select a candidate for a cell and constrain each of the cell's adjacent successors to have a different subject from it. <syntaxhighlight lang="prolog">allocation( [], _Next, [] ). allocation( [Cell|Cells], Next, Subjects ) :- allocate_candidate( Subjects, Next, Candidate, Subjects1, Next1 ), cell( Candidate, Cell ), adjacent_successors( Cell, AdjacentSuccessors ), blocked( AdjacentSuccessors, Candidate ), allocation( Cells, Next1, Subjects1 ).</syntaxhighlight> ====allocate_candidate( +Subjects, +Next, ?Candidate, ?Subjects1, ?Next1 )==== holds when <var>Candidate</var> is taken from <var>Subjects</var> leaving <var>Subjects1</var>. <var>Candidate</var> is represented by a subject number &le; <var>Next</var>. <var>Next1</var> is the highest subject that can be allocated to the next cell, ensuring that the first candidate for each subject is allocated in order. <syntaxhighlight lang="prolog">allocate_candidate( [Subject|Subjects], Next, Candidate, Subjects1, Next1 ) :- Subject = [Candidate|Candidates], Candidate =< Next, Next1 is max(Candidate+1,Next), residual_candidates( Candidates, Subjects, Subjects1 ). allocate_candidate( [Subject|Subjects], Next, Candidate, [Subject|Subjects1], Next1 ) :- Subject = [Candidate0|_Candidates], Candidate0 < Next, allocate_candidate( Subjects, Next, Candidate, Subjects1, Next1 ). residual_candidates( [], Subjects, Subjects ). residual_candidates( Candidates, Subjects, [Candidates|Subjects] ) :- Candidates = [_|_].</syntaxhighlight> ====matrix( ?Matrix )==== holds when <var>Matrix</var> is a list of cells ordered by their (x,y) coordinates. Each cell is described by 5 binary digits, which indicate the subject assigned to it, and the set of successors of the cell that are adjacent to it. <syntaxhighlight lang="prolog">matrix( Matrix ) :- layout( Layout ), matrix1( Layout, _Index, Matrix ). matrix1( [], _Index, [] ). matrix1( [(Row, Column)|Layout], Index, [Cell|Matrix] ) :- location_cell( Row, Column, Index, Cell ), findall( (Row1, Column1), ( successor( (Row, Column), (Row1, Column1) ), adjacent(Row, Row1), adjacent(Column, Column1) ), AdjacentSuccessorLocations ), location_cells( AdjacentSuccessorLocations, Index, AdjacentSuccessors ), adjacent_successors( Cell, AdjacentSuccessors ), matrix1( Layout, Index, Matrix ).</syntaxhighlight> ====cell( ?Subject, ?Cell )==== holds when <var>Cell</var> is the cell representation for <var>Subject</var>. <syntaxhighlight lang="prolog">cell( 1, cell(1,0,0,0,0,_) ). cell( 2, cell(0,1,0,0,0,_) ). cell( 3, cell(0,0,1,0,0,_) ). cell( 4, cell(0,0,0,1,0,_) ). cell( 5, cell(0,0,0,0,1,_) ).</syntaxhighlight> ====block( ?Subject, ?Block )==== holds when <var>Block</var> is a cell representation that is incompatible with <var>Subject</var>. <syntaxhighlight lang="prolog">block( 1, cell(0,_,_,_,_,_) ). block( 2, cell(_,0,_,_,_,_) ). block( 3, cell(_,_,0,_,_,_) ). block( 4, cell(_,_,_,0,_,_) ). block( 5, cell(_,_,_,_,0,_) ).</syntaxhighlight> ====adjacent_successors( ?Cell, ?AdjacentSuccesors )==== holds when <var>AdjacentSuccesors</var> is the set of successors of <var>Cell</var> that are adjacent to it. <syntaxhighlight lang="prolog">adjacent_successors( cell(_,_,_,_,_,AdjacentSuccesors), AdjacentSuccesors ).</syntaxhighlight> ====blocked( +Blocked, ?Subject )==== holds when all the cells in <var>Blocked</var> are incompatible with <var>Subject</var>. <syntaxhighlight lang="prolog">blocked( [], _Subject ). blocked( [Cell|Blocked], Subject ) :- block( Subject, Cell ), blocked( Blocked, Subject ).</syntaxhighlight> ====adjacent( +Coordinate0, ?Coordinate1 )==== holds when <var>Coordinate0</var> and <var>Coordinate1</var> are the same or differ by 1. <syntaxhighlight lang="prolog">adjacent( N, N ). adjacent( N0, N1 ) :- N1 is N0 + 1. adjacent( N0, N1 ) :- N1 is N0 - 1.</syntaxhighlight> ====location_cells( ?Locations, ?Index, ?Cells )==== holds when <var>Index</var> is a 6 &times; 6 array, <var>Locations</var> is a list of (Row,Column) pairs and <var>Cells</var> is the list of matching cells dereferenced from <var>Index</var>. <syntaxhighlight lang="prolog">location_cells( [], _Index, [] ). location_cells( [(Row, Column)|Locs], Index, [Cell|Cells] ) :- location_cell( Row, Column, Index, Cell ), location_cells( Locs, Index, Cells ).</syntaxhighlight> ====location_cell( ?Row, ?Column, ?Index, ?Cell )==== holds when <var>Index</var> is a 6 &times; 6 array with <var>Cell</var> at location (<var>Row</var>,<var>Column</var>). <syntaxhighlight lang="prolog">location_cell( Row, Column, Index, Cell ) :- select_nth( Row, Index, IndexRow ), select_nth( Column, IndexRow, Cell ).</syntaxhighlight> ====select_nth( ?N, ?Array, ?Element )==== holds when <var>Element</var> is the <var>N</var>th element of <var>Array</var>. <syntaxhighlight lang="prolog">select_nth( 1, array_6(A,_B,_C,_D,_E,_F), A ). select_nth( 2, array_6(_A,B,_C,_D,_E,_F), B ). select_nth( 3, array_6(_A,_B,C,_D,_E,_F), C ). select_nth( 4, array_6(_A,_B,_C,D,_E,_F), D ). select_nth( 5, array_6(_A,_B,_C,_D,E,_F), E ). select_nth( 6, array_6(_A,_B,_C,_D,_E,F), F ).</syntaxhighlight> ====successor( ?Coordinates0, ?Coordinates1 )==== holds when <var>Coordinates0</var> and <var>Coordinates1</var> are valid cell positions and <var>Coordinates0</var> &lt;<var>Coordinates1</var>. <syntaxhighlight lang="prolog">successor( Coordinates0, Coordinates1 ) :- layout( Layout ), append( _Prefix, [Coordinates0|Successors], Layout ), member( Coordinates1, Successors ).</syntaxhighlight> ====candidates( ?Subjects, ?Candidates )==== holds when there are 4 <var>Candidates</var> for each subject in <var>Subjects</var>. <syntaxhighlight lang="prolog">candidates( [], [] ). candidates( [Subj|Subjects], [[Subj,Subj,Subj,Subj]|Candidates] ) :- candidates( Subjects, Candidates ).</syntaxhighlight> ====layout( ?Layout )==== holds when <var>Layout</var> is the sequence of all (x,y) co-ordinates of valid cells. <syntaxhighlight lang="prolog">layout( [ (1,2), (2,2),(2,3),(2,4),(2,5),(2,6), (3,2),(3,3),(3,4),(3,5), (4,2),(4,3),(4,4),(4,5), (5,1),(5,2),(5,3),(5,4),(5,5), (6,5) ] ).</syntaxhighlight> Load a small library of [[Puzzle Utilities]]. <syntaxhighlight lang="prolog">:- ensure_loaded( misc ).</syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/download/nut1.txt here]. === Result === This program reports '''29870''' solutions. 2032e4fd0df208f83c9c2e39663154ec7b433bb2 125 110 2015-07-22T23:01:11Z John 2 Updated comp.lang.prolog link wikitext text/x-wiki ;Constrained Permutations in Prolog __NOTOC__ Problem posted to [https://groups.google.com/forum/#!msg/comp.lang.prolog/e_-sEr4tuF4/gEEKXjLqhKkJ comp.lang.prolog] by Daniel Dudley ===Problem Statement=== <blockquote>A university was to hold an examination in 5 subjects: Norwegian, German, English, French and Spanish. In each of these languages there were 4 candidates. The examination room was therefore divided into 20 cells, as shown in the figure below (view this in a fixed font): <pre> X X X X X X X X X X X X X X X X X X X X</pre> The university's administration wanted to secure themselves against cheating. Candidates in the same language were to be completely isolated from each other - so much so that their cells were not to coincide even at the corners. A young lecturer was given the job of finding a solution to the problem, which he did, and justly received a pat on the back from the dean. Now it just so happens that the dean is an ardent prolog programmer in his spare time (how else could he make dean?) and, realizing that there could be several solutions to the problem, used his skills to find all solutions. Can you do the same? </blockquote> ===Note=== &ldquo;Several solutions&rdquo; doesn't really cover it! Assuming that by &lsquo;a solution&rsquo; we mean finding a mapping between candidates and cells, then, having found one such solution, we can easily find 955,514,879 other members of its solution &ldquo;family&rdquo; through: * ''candidate permutation'': There are (4!)⁵ permutations of the candidates within the cells allocated to their subjects; * ''subject permutation'': we can multiply the candidate permutations by the 5! permutations of the subjects allocated to particular sets of cells. This means that the total number of solutions is 955514880 &times; D where D is the number of solution families i.e. solutions that cannot be derived from each other by candidate or subject permutation. Finding [[#Result|D]] is the more interesting problem solved by this program. ====nut1( ?Solutions )==== <var>Solutions</var> is the number of distinct solutions to the subject/cell allocation problem for any five different subjects. <syntaxhighlight lang="prolog">nut1( Solutions ) :- Norwegian = 1, German = 2, English = 3, French = 4, Spanish = 5, candidates( [Norwegian,German,English,French,Spanish], Candidates ), matrix( Cells ), count_solutions( allocate(Cells,Candidates), Solutions ).</syntaxhighlight> ====allocate( +Cells, +Candidates )==== holds when each cell in <var>Cells</var> holds a candidate from <var>Candidates</var>. <syntaxhighlight lang="prolog">allocate( Cells, Candidates ) :- allocation( Cells, 1, Candidates ).</syntaxhighlight> ====allocation( +Cells, +NextSubject, +Subjects )==== holds when <var>Cells</var> is a representation of a distinct solution to the subject/cell allocation problem. <var>NextSubject</var> is the highest subject that can be allocated next, while <var>Subjects</var> is the list of subjects needing allocation to <var>Cells</var>. Each subject is represented by a list, in which each occurrence of the subject number represents a candidate. We guarantee distinct solutions by ensuring that the allocation is made on the following basis: * For each subject: the location of the N+1th candidate must be a successor of the location of the Nth candidate - to eliminate candidate permutations. * The location of the first candidate of the N+1th subject must be a successor of the location of the first candidate of the Nth subject &ndash; to eliminate subject permutations. Operationally, at each step we select a candidate for a cell and constrain each of the cell's adjacent successors to have a different subject from it. <syntaxhighlight lang="prolog">allocation( [], _Next, [] ). allocation( [Cell|Cells], Next, Subjects ) :- allocate_candidate( Subjects, Next, Candidate, Subjects1, Next1 ), cell( Candidate, Cell ), adjacent_successors( Cell, AdjacentSuccessors ), blocked( AdjacentSuccessors, Candidate ), allocation( Cells, Next1, Subjects1 ).</syntaxhighlight> ====allocate_candidate( +Subjects, +Next, ?Candidate, ?Subjects1, ?Next1 )==== holds when <var>Candidate</var> is taken from <var>Subjects</var> leaving <var>Subjects1</var>. <var>Candidate</var> is represented by a subject number &le; <var>Next</var>. <var>Next1</var> is the highest subject that can be allocated to the next cell, ensuring that the first candidate for each subject is allocated in order. <syntaxhighlight lang="prolog">allocate_candidate( [Subject|Subjects], Next, Candidate, Subjects1, Next1 ) :- Subject = [Candidate|Candidates], Candidate =< Next, Next1 is max(Candidate+1,Next), residual_candidates( Candidates, Subjects, Subjects1 ). allocate_candidate( [Subject|Subjects], Next, Candidate, [Subject|Subjects1], Next1 ) :- Subject = [Candidate0|_Candidates], Candidate0 < Next, allocate_candidate( Subjects, Next, Candidate, Subjects1, Next1 ). residual_candidates( [], Subjects, Subjects ). residual_candidates( Candidates, Subjects, [Candidates|Subjects] ) :- Candidates = [_|_].</syntaxhighlight> ====matrix( ?Matrix )==== holds when <var>Matrix</var> is a list of cells ordered by their (x,y) coordinates. Each cell is described by 5 binary digits, which indicate the subject assigned to it, and the set of successors of the cell that are adjacent to it. <syntaxhighlight lang="prolog">matrix( Matrix ) :- layout( Layout ), matrix1( Layout, _Index, Matrix ). matrix1( [], _Index, [] ). matrix1( [(Row, Column)|Layout], Index, [Cell|Matrix] ) :- location_cell( Row, Column, Index, Cell ), findall( (Row1, Column1), ( successor( (Row, Column), (Row1, Column1) ), adjacent(Row, Row1), adjacent(Column, Column1) ), AdjacentSuccessorLocations ), location_cells( AdjacentSuccessorLocations, Index, AdjacentSuccessors ), adjacent_successors( Cell, AdjacentSuccessors ), matrix1( Layout, Index, Matrix ).</syntaxhighlight> ====cell( ?Subject, ?Cell )==== holds when <var>Cell</var> is the cell representation for <var>Subject</var>. <syntaxhighlight lang="prolog">cell( 1, cell(1,0,0,0,0,_) ). cell( 2, cell(0,1,0,0,0,_) ). cell( 3, cell(0,0,1,0,0,_) ). cell( 4, cell(0,0,0,1,0,_) ). cell( 5, cell(0,0,0,0,1,_) ).</syntaxhighlight> ====block( ?Subject, ?Block )==== holds when <var>Block</var> is a cell representation that is incompatible with <var>Subject</var>. <syntaxhighlight lang="prolog">block( 1, cell(0,_,_,_,_,_) ). block( 2, cell(_,0,_,_,_,_) ). block( 3, cell(_,_,0,_,_,_) ). block( 4, cell(_,_,_,0,_,_) ). block( 5, cell(_,_,_,_,0,_) ).</syntaxhighlight> ====adjacent_successors( ?Cell, ?AdjacentSuccesors )==== holds when <var>AdjacentSuccesors</var> is the set of successors of <var>Cell</var> that are adjacent to it. <syntaxhighlight lang="prolog">adjacent_successors( cell(_,_,_,_,_,AdjacentSuccesors), AdjacentSuccesors ).</syntaxhighlight> ====blocked( +Blocked, ?Subject )==== holds when all the cells in <var>Blocked</var> are incompatible with <var>Subject</var>. <syntaxhighlight lang="prolog">blocked( [], _Subject ). blocked( [Cell|Blocked], Subject ) :- block( Subject, Cell ), blocked( Blocked, Subject ).</syntaxhighlight> ====adjacent( +Coordinate0, ?Coordinate1 )==== holds when <var>Coordinate0</var> and <var>Coordinate1</var> are the same or differ by 1. <syntaxhighlight lang="prolog">adjacent( N, N ). adjacent( N0, N1 ) :- N1 is N0 + 1. adjacent( N0, N1 ) :- N1 is N0 - 1.</syntaxhighlight> ====location_cells( ?Locations, ?Index, ?Cells )==== holds when <var>Index</var> is a 6 &times; 6 array, <var>Locations</var> is a list of (Row,Column) pairs and <var>Cells</var> is the list of matching cells dereferenced from <var>Index</var>. <syntaxhighlight lang="prolog">location_cells( [], _Index, [] ). location_cells( [(Row, Column)|Locs], Index, [Cell|Cells] ) :- location_cell( Row, Column, Index, Cell ), location_cells( Locs, Index, Cells ).</syntaxhighlight> ====location_cell( ?Row, ?Column, ?Index, ?Cell )==== holds when <var>Index</var> is a 6 &times; 6 array with <var>Cell</var> at location (<var>Row</var>,<var>Column</var>). <syntaxhighlight lang="prolog">location_cell( Row, Column, Index, Cell ) :- select_nth( Row, Index, IndexRow ), select_nth( Column, IndexRow, Cell ).</syntaxhighlight> ====select_nth( ?N, ?Array, ?Element )==== holds when <var>Element</var> is the <var>N</var>th element of <var>Array</var>. <syntaxhighlight lang="prolog">select_nth( 1, array_6(A,_B,_C,_D,_E,_F), A ). select_nth( 2, array_6(_A,B,_C,_D,_E,_F), B ). select_nth( 3, array_6(_A,_B,C,_D,_E,_F), C ). select_nth( 4, array_6(_A,_B,_C,D,_E,_F), D ). select_nth( 5, array_6(_A,_B,_C,_D,E,_F), E ). select_nth( 6, array_6(_A,_B,_C,_D,_E,F), F ).</syntaxhighlight> ====successor( ?Coordinates0, ?Coordinates1 )==== holds when <var>Coordinates0</var> and <var>Coordinates1</var> are valid cell positions and <var>Coordinates0</var> &lt;<var>Coordinates1</var>. <syntaxhighlight lang="prolog">successor( Coordinates0, Coordinates1 ) :- layout( Layout ), append( _Prefix, [Coordinates0|Successors], Layout ), member( Coordinates1, Successors ).</syntaxhighlight> ====candidates( ?Subjects, ?Candidates )==== holds when there are 4 <var>Candidates</var> for each subject in <var>Subjects</var>. <syntaxhighlight lang="prolog">candidates( [], [] ). candidates( [Subj|Subjects], [[Subj,Subj,Subj,Subj]|Candidates] ) :- candidates( Subjects, Candidates ).</syntaxhighlight> ====layout( ?Layout )==== holds when <var>Layout</var> is the sequence of all (x,y) co-ordinates of valid cells. <syntaxhighlight lang="prolog">layout( [ (1,2), (2,2),(2,3),(2,4),(2,5),(2,6), (3,2),(3,3),(3,4),(3,5), (4,2),(4,3),(4,4),(4,5), (5,1),(5,2),(5,3),(5,4),(5,5), (6,5) ] ).</syntaxhighlight> Load a small library of [[Puzzle Utilities]]. <syntaxhighlight lang="prolog">:- ensure_loaded( misc ).</syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/download/nut1.txt here]. === Result === This program reports '''29870''' solutions. 60d505aedce2150fdf61ef0d40085ffa9907ef62 151 125 2016-05-14T23:22:34Z John 2 Represent the figure as a Prolog list of lists of spaces and xs. wikitext text/x-wiki ;Constrained Permutations in Prolog __NOTOC__ Problem posted to [https://groups.google.com/forum/#!msg/comp.lang.prolog/e_-sEr4tuF4/gEEKXjLqhKkJ comp.lang.prolog] by Daniel Dudley ===Problem Statement=== <blockquote>A university was to hold an examination in 5 subjects: Norwegian, German, English, French and Spanish. In each of these languages there were 4 candidates. The examination room was therefore divided into 20 cells, as shown in the figure below (view this in a fixed font): <syntaxhighlight lang="prolog">figure( [" X ", " XXXXX", " XXXX ", " XXXX ", "XXXXX ", " X "] ).</syntaxhighlight> The university's administration wanted to secure themselves against cheating. Candidates in the same language were to be completely isolated from each other - so much so that their cells were not to coincide even at the corners. A young lecturer was given the job of finding a solution to the problem, which he did, and justly received a pat on the back from the dean. Now it just so happens that the dean is an ardent prolog programmer in his spare time (how else could he make dean?) and, realizing that there could be several solutions to the problem, used his skills to find all solutions. Can you do the same? </blockquote> ===Note=== &ldquo;Several solutions&rdquo; doesn't really cover it! Assuming that by &lsquo;a solution&rsquo; we mean finding a mapping between candidates and cells, then, having found one such solution, we can easily find 955,514,879 other members of its solution &ldquo;family&rdquo; through: * ''candidate permutation'': There are (4!)⁵ permutations of the candidates within the cells allocated to their subjects; * ''subject permutation'': we can multiply the candidate permutations by the 5! permutations of the subjects allocated to particular sets of cells. This means that the total number of solutions is 955514880 &times; D where D is the number of solution families i.e. solutions that cannot be derived from each other by candidate or subject permutation. Finding [[#Result|D]] is the more interesting problem solved by this program. ====nut1( ?Solutions )==== <var>Solutions</var> is the number of distinct solutions to the subject/cell allocation problem for any five different subjects. <syntaxhighlight lang="prolog">nut1( Solutions ) :- Norwegian = 1, German = 2, English = 3, French = 4, Spanish = 5, candidates( [Norwegian,German,English,French,Spanish], Candidates ), matrix( Cells ), count_solutions( allocate(Cells,Candidates), Solutions ).</syntaxhighlight> ====allocate( +Cells, +Candidates )==== holds when each cell in <var>Cells</var> holds a candidate from <var>Candidates</var>. <syntaxhighlight lang="prolog">allocate( Cells, Candidates ) :- allocation( Cells, 1, Candidates ).</syntaxhighlight> ====allocation( +Cells, +NextSubject, +Subjects )==== holds when <var>Cells</var> is a representation of a distinct solution to the subject/cell allocation problem. <var>NextSubject</var> is the highest subject that can be allocated next, while <var>Subjects</var> is the list of subjects needing allocation to <var>Cells</var>. Each subject is represented by a list, in which each occurrence of the subject number represents a candidate. We guarantee distinct solutions by ensuring that the allocation is made on the following basis: * For each subject: the location of the N+1th candidate must be a successor of the location of the Nth candidate - to eliminate candidate permutations. * The location of the first candidate of the N+1th subject must be a successor of the location of the first candidate of the Nth subject &ndash; to eliminate subject permutations. Operationally, at each step we select a candidate for a cell and constrain each of the cell's adjacent successors to have a different subject from it. <syntaxhighlight lang="prolog">allocation( [], _Next, [] ). allocation( [Cell|Cells], Next, Subjects ) :- allocate_candidate( Subjects, Next, Candidate, Subjects1, Next1 ), cell( Candidate, Cell ), adjacent_successors( Cell, AdjacentSuccessors ), blocked( AdjacentSuccessors, Candidate ), allocation( Cells, Next1, Subjects1 ).</syntaxhighlight> ====allocate_candidate( +Subjects, +Next, ?Candidate, ?Subjects1, ?Next1 )==== holds when <var>Candidate</var> is taken from <var>Subjects</var> leaving <var>Subjects1</var>. <var>Candidate</var> is represented by a subject number &le; <var>Next</var>. <var>Next1</var> is the highest subject that can be allocated to the next cell, ensuring that the first candidate for each subject is allocated in order. <syntaxhighlight lang="prolog">allocate_candidate( [Subject|Subjects], Next, Candidate, Subjects1, Next1 ) :- Subject = [Candidate|Candidates], Candidate =< Next, Next1 is max(Candidate+1,Next), residual_candidates( Candidates, Subjects, Subjects1 ). allocate_candidate( [Subject|Subjects], Next, Candidate, [Subject|Subjects1], Next1 ) :- Subject = [Candidate0|_Candidates], Candidate0 < Next, allocate_candidate( Subjects, Next, Candidate, Subjects1, Next1 ). residual_candidates( [], Subjects, Subjects ). residual_candidates( Candidates, Subjects, [Candidates|Subjects] ) :- Candidates = [_|_].</syntaxhighlight> ====matrix( ?Matrix )==== holds when <var>Matrix</var> is a list of cells ordered by their (x,y) coordinates. Each cell is described by 5 binary digits, which indicate the subject assigned to it, and the set of successors of the cell that are adjacent to it. <syntaxhighlight lang="prolog">matrix( Matrix ) :- layout( Layout ), matrix1( Layout, _Index, Matrix ). matrix1( [], _Index, [] ). matrix1( [(Row, Column)|Layout], Index, [Cell|Matrix] ) :- location_cell( Row, Column, Index, Cell ), findall( (Row1, Column1), ( successor( (Row, Column), (Row1, Column1) ), adjacent(Row, Row1), adjacent(Column, Column1) ), AdjacentSuccessorLocations ), location_cells( AdjacentSuccessorLocations, Index, AdjacentSuccessors ), adjacent_successors( Cell, AdjacentSuccessors ), matrix1( Layout, Index, Matrix ).</syntaxhighlight> ====cell( ?Subject, ?Cell )==== holds when <var>Cell</var> is the cell representation for <var>Subject</var>. <syntaxhighlight lang="prolog">cell( 1, cell(1,0,0,0,0,_) ). cell( 2, cell(0,1,0,0,0,_) ). cell( 3, cell(0,0,1,0,0,_) ). cell( 4, cell(0,0,0,1,0,_) ). cell( 5, cell(0,0,0,0,1,_) ).</syntaxhighlight> ====block( ?Subject, ?Block )==== holds when <var>Block</var> is a cell representation that is incompatible with <var>Subject</var>. <syntaxhighlight lang="prolog">block( 1, cell(0,_,_,_,_,_) ). block( 2, cell(_,0,_,_,_,_) ). block( 3, cell(_,_,0,_,_,_) ). block( 4, cell(_,_,_,0,_,_) ). block( 5, cell(_,_,_,_,0,_) ).</syntaxhighlight> ====adjacent_successors( ?Cell, ?AdjacentSuccesors )==== holds when <var>AdjacentSuccesors</var> is the set of successors of <var>Cell</var> that are adjacent to it. <syntaxhighlight lang="prolog">adjacent_successors( cell(_,_,_,_,_,AdjacentSuccesors), AdjacentSuccesors ).</syntaxhighlight> ====blocked( +Blocked, ?Subject )==== holds when all the cells in <var>Blocked</var> are incompatible with <var>Subject</var>. <syntaxhighlight lang="prolog">blocked( [], _Subject ). blocked( [Cell|Blocked], Subject ) :- block( Subject, Cell ), blocked( Blocked, Subject ).</syntaxhighlight> ====adjacent( +Coordinate0, ?Coordinate1 )==== holds when <var>Coordinate0</var> and <var>Coordinate1</var> are the same or differ by 1. <syntaxhighlight lang="prolog">adjacent( N, N ). adjacent( N0, N1 ) :- N1 is N0 + 1. adjacent( N0, N1 ) :- N1 is N0 - 1.</syntaxhighlight> ====location_cells( ?Locations, ?Index, ?Cells )==== holds when <var>Index</var> is a 6 &times; 6 array, <var>Locations</var> is a list of (Row,Column) pairs and <var>Cells</var> is the list of matching cells dereferenced from <var>Index</var>. <syntaxhighlight lang="prolog">location_cells( [], _Index, [] ). location_cells( [(Row, Column)|Locs], Index, [Cell|Cells] ) :- location_cell( Row, Column, Index, Cell ), location_cells( Locs, Index, Cells ).</syntaxhighlight> ====location_cell( ?Row, ?Column, ?Index, ?Cell )==== holds when <var>Index</var> is a 6 &times; 6 array with <var>Cell</var> at location (<var>Row</var>,<var>Column</var>). <syntaxhighlight lang="prolog">location_cell( Row, Column, Index, Cell ) :- select_nth( Row, Index, IndexRow ), select_nth( Column, IndexRow, Cell ).</syntaxhighlight> ====select_nth( ?N, ?Array, ?Element )==== holds when <var>Element</var> is the <var>N</var>th element of <var>Array</var>. <syntaxhighlight lang="prolog">select_nth( 1, array_6(A,_B,_C,_D,_E,_F), A ). select_nth( 2, array_6(_A,B,_C,_D,_E,_F), B ). select_nth( 3, array_6(_A,_B,C,_D,_E,_F), C ). select_nth( 4, array_6(_A,_B,_C,D,_E,_F), D ). select_nth( 5, array_6(_A,_B,_C,_D,E,_F), E ). select_nth( 6, array_6(_A,_B,_C,_D,_E,F), F ).</syntaxhighlight> ====successor( ?Coordinates0, ?Coordinates1 )==== holds when <var>Coordinates0</var> and <var>Coordinates1</var> are valid cell positions and <var>Coordinates0</var> &lt;<var>Coordinates1</var>. <syntaxhighlight lang="prolog">successor( Coordinates0, Coordinates1 ) :- layout( Layout ), append( _Prefix, [Coordinates0|Successors], Layout ), member( Coordinates1, Successors ).</syntaxhighlight> ====candidates( ?Subjects, ?Candidates )==== holds when there are 4 <var>Candidates</var> for each subject in <var>Subjects</var>. <syntaxhighlight lang="prolog">candidates( [], [] ). candidates( [Subj|Subjects], [[Subj,Subj,Subj,Subj]|Candidates] ) :- candidates( Subjects, Candidates ).</syntaxhighlight> ====layout( ?Layout )==== holds when <var>Layout</var> is the sequence of all (x,y) co-ordinates of valid cells. <syntaxhighlight lang="prolog">layout( [ (1,2), (2,2),(2,3),(2,4),(2,5),(2,6), (3,2),(3,3),(3,4),(3,5), (4,2),(4,3),(4,4),(4,5), (5,1),(5,2),(5,3),(5,4),(5,5), (6,5) ] ).</syntaxhighlight> Load a small library of [[Puzzle Utilities]]. <syntaxhighlight lang="prolog">:- ensure_loaded( misc ).</syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/download/nut1.txt here]. === Result === This program reports '''29870''' solutions. 052bb58ef43132ac57e95058eb509cb5173df8bd 0 13 111 96 2015-05-21T19:39:31Z John 2 wikitext text/x-wiki __NOTOC__ Although this problem has a straightforward solution, it does demonstrate the value of thinking declaratively in understanding the problem, which relates to &ldquo;don't know&rdquo; nondeterminism, and an appropriate use of lemmas. == Problem: == [http://groups.google.com/group/de.comp.lang.java/msg/12cb7c2083cde4f8 Problem as posted to comp.lang.prolog] by Thorsten Seelend. Also known as Hans Freudenthal's [[wikipedia:Impossible Puzzle|Impossible Puzzle]]. <blockquote>Mister X thinks about two integers between 1 and 100 excluding: </blockquote> =====MISTERX: Two integers, X and Y between 2 and 99 (My formalization of the given information)===== <syntaxhighlight lang="prolog">two_integers( X, Y ) :- between( 2, 98, X ), between( X, 99, Y ).</syntaxhighlight> He tells Susan the Sum of them and Peter their Product. Their task is to get the two original values without telling each other the numbers that Mister X told them. <blockquote>After some time Peter says: &ldquo;I can't say definitively which are the original numbers.&rdquo;</blockquote> =====PETER1: There is more than one pair of factors giving Product===== <syntaxhighlight lang="prolog">property( peter1, Product ) :- \+ unique_factors( Product ).</syntaxhighlight> <blockquote>Then Susan responds: &ldquo;Neither can I, but I knew that you couldn't know it.&rdquo</blockquote> =====SUSAN1: The product of ''every'' pair of summands giving Sum has the property PETER1===== <syntaxhighlight lang="prolog">property( susan1, Sum ) :- forall( ordered_summands(Sum, X, Y), peter1(X * Y) ).</syntaxhighlight> <blockquote>Peter: &ldquo;Really? So now I know the original numbers&rdquo;.</blockquote> =====PETER2: ''exactly one'' pair of factors giving Product gives a sum with the property SUSAN1===== <syntaxhighlight lang="prolog">property( peter2, Product ) :- unique_solution( (ordered_factors(Product, X, Y), susan1(X+Y)) ).</syntaxhighlight> <blockquote>Susan: &ldquo;Now I know them too&rdquo;.</blockquote> =====SUSAN2: ''exactly one'' pair of summands giving Sum has a product with the property PETER2===== <syntaxhighlight lang="prolog">property( susan2, Sum ) :- unique_solution( (ordered_summands(Sum, X, Y), peter2(X * Y)) ).</syntaxhighlight> <blockquote>Question: What are the two numbers that Mister X thought of?</blockquote> =====Unique solution===== <syntaxhighlight lang="prolog">solve( X, Y ) :- unique_solution( mister_x(X, Y) ). mister_x( X, Y ) :- two_integers( X, Y ), Sum is X + Y, Product is X * Y, peter1( Product ), susan1( Sum ), peter2( Product ), susan2( Sum ).</syntaxhighlight> == Macros == <syntaxhighlight lang="prolog">peter1( Product ) :- lemma( peter1, Product ). peter2( Product ) :- lemma( peter2, Product ). susan1( Sum ) :- lemma( susan1, Sum ). susan2( Sum ) :- lemma( susan2, Sum ).</syntaxhighlight> == Lemmas == ====lemma( +Property, +Expression )==== holds wherever <var>Property</var> holds for <var>Expression</var>. Asserted facts are used to record successful (''positive'') or failed (''negative'') demonstrations. This saves recomputation without changing the meaning of the pure program. Although the use of side-effects is generally undesirable, the use of lemmas is justified when the alternative is to compromise performance or clarity. Using lemmas or tabling to cache results is an order of magnitude faster than recalculating each property every time it is used. <syntaxhighlight lang="prolog">:- dynamic positive/2, negative/2. lemma( Name, Expression ) :- Value is Expression, ( positive( Value, Name ) -> true ; \+ negative( Value, Name ) -> ( property(Name, Value) -> assert( positive(Value, Name) ) ; otherwise -> assert( negative(Value, Name) ), fail ) ).</syntaxhighlight> == Supporting Predicates == ====ordered_summands( +Sum, ?X, ?Y )==== when <var>X</var> &le; <var>Y</var> and Sum = <var>X</var>+<var>Y</var>. NB: Since <var>X</var>&le;<var>Y</var> it follows that <var>X</var> &le; <var>Sum</var>/2. <syntaxhighlight lang="prolog">ordered_summands( Z, X, Y ) :- Half is Z//2, between( 2, Half, X ), Y is Z - X, between( X, 98, Y ).</syntaxhighlight> ====ordered_factors( +Product, ?X, ?Y )==== when <var>X</var> &le; <var>Y</var> and <var>Product</var> = <var>X</var> &times; <var>Y</var>. NB: Since <var>X</var>&le;<var>Y</var> it follows that <var>X</var> &le; &radic;<var>Product</var>. <syntaxhighlight lang="prolog">ordered_factors( Z, X, Y ) :- integer_sqrt( Z, SqrtZ ), between( 2, SqrtZ, X ), Y is Z // X, between( X, 99, Y ), Z =:= X * Y.</syntaxhighlight> ====unique_factors( +Product )==== when <var>Product</var> has exactly one pair of factors. <syntaxhighlight lang="prolog">unique_factors( Product ) :- ordered_factors( Product, X, _Y ), \+ (ordered_factors(Product, X1, _Y1), X1 =\= X).</syntaxhighlight> ====integer_sqrt( +N, ?Sqrt )==== when <var>Sqrt</var>² &le; <var>N</var> and (<var>Sqrt</var>+1)² &ge; <var>N</var>. <syntaxhighlight lang="prolog">integer_sqrt( N, Sqrt ) :- Float is N * 1.0, sqrt( Float, FSqrt ), Sqrt is integer(FSqrt).</syntaxhighlight> Load a small library of [[Puzzle Utilities]]. <syntaxhighlight lang="prolog"> :- ensure_loaded( misc ). </syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/download/mister_x.txt here]. == Result == This program finds X and Y as '''4''' and '''13'''. == Tabling == Using tabling, rather than explicit lemmas, can simplify code. [https://binding-time.co.uk/download/xsb_mister_x.txt A version adapted for XSB Prolog is available here.] 4aa2d0abf4ff69dbc563dd73c6f01b4f5797196d 112 111 2015-05-27T19:36:03Z John 2 /* PETER1: There is more than one pair of factors giving Product */ wikitext text/x-wiki __NOTOC__ Although this problem has a straightforward solution, it does demonstrate the value of thinking declaratively in understanding the problem, which relates to &ldquo;don't know&rdquo; nondeterminism, and an appropriate use of lemmas. == Problem: == [http://groups.google.com/group/de.comp.lang.java/msg/12cb7c2083cde4f8 Problem as posted to comp.lang.prolog] by Thorsten Seelend. Also known as Hans Freudenthal's [[wikipedia:Impossible Puzzle|Impossible Puzzle]]. <blockquote>Mister X thinks about two integers between 1 and 100 excluding: </blockquote> =====MISTERX: Two integers, X and Y between 2 and 99 (My formalization of the given information)===== <syntaxhighlight lang="prolog">two_integers( X, Y ) :- between( 2, 98, X ), between( X, 99, Y ).</syntaxhighlight> He tells Susan the Sum of them and Peter their Product. Their task is to get the two original values without telling each other the numbers that Mister X told them. <blockquote>After some time Peter says: &ldquo;I can't say definitively which are the original numbers.&rdquo;</blockquote> =====PETER1: There is more than one pair of factors giving Product===== <syntaxhighlight lang="prolog">property( peter1, Product ) :- \+ unique_factors( Product ).</syntaxhighlight> <blockquote>Then Susan responds: &ldquo;Neither can I, but I knew that you couldn't know it.&rdquo;</blockquote> =====SUSAN1: The product of ''every'' pair of summands giving Sum has the property PETER1===== <syntaxhighlight lang="prolog">property( susan1, Sum ) :- forall( ordered_summands(Sum, X, Y), peter1(X * Y) ).</syntaxhighlight> <blockquote>Peter: &ldquo;Really? So now I know the original numbers&rdquo;.</blockquote> =====PETER2: ''exactly one'' pair of factors giving Product gives a sum with the property SUSAN1===== <syntaxhighlight lang="prolog">property( peter2, Product ) :- unique_solution( (ordered_factors(Product, X, Y), susan1(X+Y)) ).</syntaxhighlight> <blockquote>Susan: &ldquo;Now I know them too&rdquo;.</blockquote> =====SUSAN2: ''exactly one'' pair of summands giving Sum has a product with the property PETER2===== <syntaxhighlight lang="prolog">property( susan2, Sum ) :- unique_solution( (ordered_summands(Sum, X, Y), peter2(X * Y)) ).</syntaxhighlight> <blockquote>Question: What are the two numbers that Mister X thought of?</blockquote> =====Unique solution===== <syntaxhighlight lang="prolog">solve( X, Y ) :- unique_solution( mister_x(X, Y) ). mister_x( X, Y ) :- two_integers( X, Y ), Sum is X + Y, Product is X * Y, peter1( Product ), susan1( Sum ), peter2( Product ), susan2( Sum ).</syntaxhighlight> == Macros == <syntaxhighlight lang="prolog">peter1( Product ) :- lemma( peter1, Product ). peter2( Product ) :- lemma( peter2, Product ). susan1( Sum ) :- lemma( susan1, Sum ). susan2( Sum ) :- lemma( susan2, Sum ).</syntaxhighlight> == Lemmas == ====lemma( +Property, +Expression )==== holds wherever <var>Property</var> holds for <var>Expression</var>. Asserted facts are used to record successful (''positive'') or failed (''negative'') demonstrations. This saves recomputation without changing the meaning of the pure program. Although the use of side-effects is generally undesirable, the use of lemmas is justified when the alternative is to compromise performance or clarity. Using lemmas or tabling to cache results is an order of magnitude faster than recalculating each property every time it is used. <syntaxhighlight lang="prolog">:- dynamic positive/2, negative/2. lemma( Name, Expression ) :- Value is Expression, ( positive( Value, Name ) -> true ; \+ negative( Value, Name ) -> ( property(Name, Value) -> assert( positive(Value, Name) ) ; otherwise -> assert( negative(Value, Name) ), fail ) ).</syntaxhighlight> == Supporting Predicates == ====ordered_summands( +Sum, ?X, ?Y )==== when <var>X</var> &le; <var>Y</var> and Sum = <var>X</var>+<var>Y</var>. NB: Since <var>X</var>&le;<var>Y</var> it follows that <var>X</var> &le; <var>Sum</var>/2. <syntaxhighlight lang="prolog">ordered_summands( Z, X, Y ) :- Half is Z//2, between( 2, Half, X ), Y is Z - X, between( X, 98, Y ).</syntaxhighlight> ====ordered_factors( +Product, ?X, ?Y )==== when <var>X</var> &le; <var>Y</var> and <var>Product</var> = <var>X</var> &times; <var>Y</var>. NB: Since <var>X</var>&le;<var>Y</var> it follows that <var>X</var> &le; &radic;<var>Product</var>. <syntaxhighlight lang="prolog">ordered_factors( Z, X, Y ) :- integer_sqrt( Z, SqrtZ ), between( 2, SqrtZ, X ), Y is Z // X, between( X, 99, Y ), Z =:= X * Y.</syntaxhighlight> ====unique_factors( +Product )==== when <var>Product</var> has exactly one pair of factors. <syntaxhighlight lang="prolog">unique_factors( Product ) :- ordered_factors( Product, X, _Y ), \+ (ordered_factors(Product, X1, _Y1), X1 =\= X).</syntaxhighlight> ====integer_sqrt( +N, ?Sqrt )==== when <var>Sqrt</var>² &le; <var>N</var> and (<var>Sqrt</var>+1)² &ge; <var>N</var>. <syntaxhighlight lang="prolog">integer_sqrt( N, Sqrt ) :- Float is N * 1.0, sqrt( Float, FSqrt ), Sqrt is integer(FSqrt).</syntaxhighlight> Load a small library of [[Puzzle Utilities]]. <syntaxhighlight lang="prolog"> :- ensure_loaded( misc ). </syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/download/mister_x.txt here]. == Result == This program finds X and Y as '''4''' and '''13'''. == Tabling == Using tabling, rather than explicit lemmas, can simplify code. [https://binding-time.co.uk/download/xsb_mister_x.txt A version adapted for XSB Prolog is available here.] 8d5568c474b79d5d6d1f7d906b5be420c41f244f 126 112 2015-07-22T23:05:30Z John 2 Updated comp.lang.prolog link wikitext text/x-wiki __NOTOC__ Although this problem has a straightforward solution, it does demonstrate the value of thinking declaratively in understanding the problem, which relates to &ldquo;don't know&rdquo; nondeterminism, and an appropriate use of lemmas. == Problem: == [https://groups.google.com/forum/#!msg/de.comp.lang.java/xQ6T3kZGqcE/-OTNgyB8yxIJ Problem as posted to comp.lang.prolog] by Thorsten Seelend. Also known as Hans Freudenthal's [[wikipedia:Impossible Puzzle|Impossible Puzzle]]. <blockquote>Mister X thinks about two integers between 1 and 100 excluding: </blockquote> =====MISTERX: Two integers, X and Y between 2 and 99 (My formalization of the given information)===== <syntaxhighlight lang="prolog">two_integers( X, Y ) :- between( 2, 98, X ), between( X, 99, Y ).</syntaxhighlight> He tells Susan the Sum of them and Peter their Product. Their task is to get the two original values without telling each other the numbers that Mister X told them. <blockquote>After some time Peter says: &ldquo;I can't say definitively which are the original numbers.&rdquo;</blockquote> =====PETER1: There is more than one pair of factors giving Product===== <syntaxhighlight lang="prolog">property( peter1, Product ) :- \+ unique_factors( Product ).</syntaxhighlight> <blockquote>Then Susan responds: &ldquo;Neither can I, but I knew that you couldn't know it.&rdquo;</blockquote> =====SUSAN1: The product of ''every'' pair of summands giving Sum has the property PETER1===== <syntaxhighlight lang="prolog">property( susan1, Sum ) :- forall( ordered_summands(Sum, X, Y), peter1(X * Y) ).</syntaxhighlight> <blockquote>Peter: &ldquo;Really? So now I know the original numbers&rdquo;.</blockquote> =====PETER2: ''exactly one'' pair of factors giving Product gives a sum with the property SUSAN1===== <syntaxhighlight lang="prolog">property( peter2, Product ) :- unique_solution( (ordered_factors(Product, X, Y), susan1(X+Y)) ).</syntaxhighlight> <blockquote>Susan: &ldquo;Now I know them too&rdquo;.</blockquote> =====SUSAN2: ''exactly one'' pair of summands giving Sum has a product with the property PETER2===== <syntaxhighlight lang="prolog">property( susan2, Sum ) :- unique_solution( (ordered_summands(Sum, X, Y), peter2(X * Y)) ).</syntaxhighlight> <blockquote>Question: What are the two numbers that Mister X thought of?</blockquote> =====Unique solution===== <syntaxhighlight lang="prolog">solve( X, Y ) :- unique_solution( mister_x(X, Y) ). mister_x( X, Y ) :- two_integers( X, Y ), Sum is X + Y, Product is X * Y, peter1( Product ), susan1( Sum ), peter2( Product ), susan2( Sum ).</syntaxhighlight> == Macros == <syntaxhighlight lang="prolog">peter1( Product ) :- lemma( peter1, Product ). peter2( Product ) :- lemma( peter2, Product ). susan1( Sum ) :- lemma( susan1, Sum ). susan2( Sum ) :- lemma( susan2, Sum ).</syntaxhighlight> == Lemmas == ====lemma( +Property, +Expression )==== holds wherever <var>Property</var> holds for <var>Expression</var>. Asserted facts are used to record successful (''positive'') or failed (''negative'') demonstrations. This saves recomputation without changing the meaning of the pure program. Although the use of side-effects is generally undesirable, the use of lemmas is justified when the alternative is to compromise performance or clarity. Using lemmas or tabling to cache results is an order of magnitude faster than recalculating each property every time it is used. <syntaxhighlight lang="prolog">:- dynamic positive/2, negative/2. lemma( Name, Expression ) :- Value is Expression, ( positive( Value, Name ) -> true ; \+ negative( Value, Name ) -> ( property(Name, Value) -> assert( positive(Value, Name) ) ; otherwise -> assert( negative(Value, Name) ), fail ) ).</syntaxhighlight> == Supporting Predicates == ====ordered_summands( +Sum, ?X, ?Y )==== when <var>X</var> &le; <var>Y</var> and Sum = <var>X</var>+<var>Y</var>. NB: Since <var>X</var>&le;<var>Y</var> it follows that <var>X</var> &le; <var>Sum</var>/2. <syntaxhighlight lang="prolog">ordered_summands( Z, X, Y ) :- Half is Z//2, between( 2, Half, X ), Y is Z - X, between( X, 98, Y ).</syntaxhighlight> ====ordered_factors( +Product, ?X, ?Y )==== when <var>X</var> &le; <var>Y</var> and <var>Product</var> = <var>X</var> &times; <var>Y</var>. NB: Since <var>X</var>&le;<var>Y</var> it follows that <var>X</var> &le; &radic;<var>Product</var>. <syntaxhighlight lang="prolog">ordered_factors( Z, X, Y ) :- integer_sqrt( Z, SqrtZ ), between( 2, SqrtZ, X ), Y is Z // X, between( X, 99, Y ), Z =:= X * Y.</syntaxhighlight> ====unique_factors( +Product )==== when <var>Product</var> has exactly one pair of factors. <syntaxhighlight lang="prolog">unique_factors( Product ) :- ordered_factors( Product, X, _Y ), \+ (ordered_factors(Product, X1, _Y1), X1 =\= X).</syntaxhighlight> ====integer_sqrt( +N, ?Sqrt )==== when <var>Sqrt</var>² &le; <var>N</var> and (<var>Sqrt</var>+1)² &ge; <var>N</var>. <syntaxhighlight lang="prolog">integer_sqrt( N, Sqrt ) :- Float is N * 1.0, sqrt( Float, FSqrt ), Sqrt is integer(FSqrt).</syntaxhighlight> Load a small library of [[Puzzle Utilities]]. <syntaxhighlight lang="prolog"> :- ensure_loaded( misc ). </syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/download/mister_x.txt here]. == Result == This program finds X and Y as '''4''' and '''13'''. == Tabling == Using tabling, rather than explicit lemmas, can simplify code. [https://binding-time.co.uk/download/xsb_mister_x.txt A version adapted for XSB Prolog is available here.] 6a45c8d0d2f0a1e9f3c8ce7063c8740c7cc44f24 0 14 113 65 2015-05-27T21:22:24Z John 2 wikitext text/x-wiki __NOTOC__ <blockquote>Problem posted to [http://groups.google.com/group/comp.lang.prolog/msg/269130cea31106d2 comp.lang.prolog] by Paul Nothman: &ldquo;This problem was recently in a Mathematics competition. Although I completed it through logic and mathematics, without the aid of a computer, I'm wondering if and how it could be answered using prolog.&rdquo; </blockquote> == Problem Statement == The problem is as follows: World theme park has seven attractions which are so far apart that there needs to be a network of monorails, called zoomtracks, to transport the patrons between attractions. There is exactly one zoomtrack between each pair of attractions. Each zoomtrack can only transport patrons in one direction. The network is constructed so that two friends can always meet at a third attraction after exactly one trip each from any two attractions. Hint: Each attraction leads to and is led to by 3 other attractions. There are 21 zoomtracks altogether. Find the entire configuration of the theme park given the following: (The first letter of each line is the attraction from which the zoomtrack comes and the one beside it is where the zoomtrack leads to). SU SO ST UO UN UP OT ON NP TU == Solution Overview == An interesting aspect of this puzzle is the given partial solution. What is its purpose? Is it supposed to help or hinder? In fact, the partial solution allows relatively naive methods to find the right answer in reasonable time. However, I've chosen to implement a method that is not dependent on the partial solution. The key to this approach is the generation of the ''stations'' data-structures, which '''may''' be partially instantiated with the given solution, before the search for a complete solution begins. The requirements of the problem are that each attraction will have three destinations that can be reached by a single zoomtrack, and that every pair of attractions must have a destination in common. This solution uses the insight that every pair of attractions must have '''exactly one''' destination in common. ====zoom==== finds a solution and then prints it. <syntaxhighlight lang="prolog">zoom :- zoom_tracks( ZoomTracks ), print_zoom_tracks( ZoomTracks ).</syntaxhighlight> ====zoom_tracks( ?ZoomTracks )==== holds when <var>ZoomTracks</var> is a set of Attraction × Links × Destinations tuples, describing a valid configuration of zoomtracks, such that each pair of attractions has exactly one destination in common. The predicate network/2 always generates viable solutions, but a simple assertion is used to demonstrate that the solution is valid directly. <syntaxhighlight lang="prolog">zoom_tracks( ZoomTracks ) :- station_origin( Station, Attraction ), station_destinations( Station, Destinations ), length( Destinations, 3 ), findall( Station, attraction( Attraction ), ZoomTracks ), findall( [Dest,Dest,Dest], attraction( Dest ), PossibleDestinations ), unified_zoomtracks( ZoomTracks ), connections( ZoomTracks ), network( ZoomTracks, PossibleDestinations ), forall( pair_of_stations( ZoomTracks, Station1, Station2 ), friends_can_meet( Station1, Station2 ) ).</syntaxhighlight> ====unified_zoomtracks( +ZoomTracks )==== holds when <var>ZoomTracks</var> is a set of Attraction × Links × Destinations tuples such that each link between two Attractions is represented by a variable shared between the two attractions. In each tuple, the Link variable denoting the Attraction is bound to 'self'. <syntaxhighlight lang="prolog">unified_zoomtracks( ZoomTracks ) :- station_origin( First, Attraction1 ), station_origin( Second, Attraction2 ), findall( Attraction1-Attraction2, pair_of_stations(ZoomTracks, First, Second), Linkage ), unified_links( Linkage, ZoomTracks ).</syntaxhighlight> ====unified_links( +Linkage, +ZoomTracks )==== holds when <var>Linkage</var> is a list of Attraction1-Attraction2 pairs such that in <var>ZoomTracks</var>: * The link variables denoting Attraction1 for Attraction2 and vice versa are unified. * The link variables denoting Attraction1 for Attraction1 and Attraction2 for Attraction2 are bound to 'self'. <syntaxhighlight lang="prolog">unified_links( [], _ZoomTracks ). unified_links( [First-Second|Linkage], ZoomTracks ) :- station_origin( Station1, First ), station_links( Station1, Links1 ), station_origin( Station2, Second ), station_links( Station2, Links2 ), memberchk( Station1, ZoomTracks ), memberchk( Station2, ZoomTracks ), link_receiver( First, Links2, Receiver ), link_receiver( Second, Links1, Receiver ), link_receiver( First, Links1, self ), link_receiver( Second, Links2, self ), unified_links( Linkage, ZoomTracks ).</syntaxhighlight> ====connections( ?ZoomTracks )==== holds when the given connections have been applied to <var>ZoomTracks</var>. Note that this can be made vacuous without any significant effect on performance. <syntaxhighlight lang="prolog">connections( ZoomTracks ) :- connection( s, u, ZoomTracks ), connection( s, o, ZoomTracks ), connection( s, t, ZoomTracks ), connection( u, o, ZoomTracks ), connection( u, n, ZoomTracks ), connection( u, p, ZoomTracks ), connection( o, t, ZoomTracks ), connection( o, n, ZoomTracks ), connection( n, p, ZoomTracks ), connection( t, u, ZoomTracks ).</syntaxhighlight> ====connection( +Source, +Destination, +ZoomTracks )==== holds when <var>ZoomTracks</var> contains a connection from <var>Source</var> to <var>Destination</var>. <syntaxhighlight lang="prolog">connection( From, To, ZoomTracks ) :- station_origin( Station, From ), station_links( Station, Links ), station_destinations( Station, Destinations ), memberchk( Station, ZoomTracks ), memberchk( To, Destinations ), link_receiver( To, Links, To ).</syntaxhighlight> ====pair_of_stations( +ZoomTracks, ?Station1, ?Station2 )==== holds when <var>Station1</var> and <var>Station2</var> are distinct elements of <var>ZoomTracks</var>, avoiding redundant solutions. <syntaxhighlight lang="prolog">pair_of_stations( [Station1|ZoomTracks], Station1, Station2 ) :- member( Station2, ZoomTracks ). pair_of_stations( [_Station0|ZoomTracks], Station1, Station2 ) :- pair_of_stations( ZoomTracks, Station1, Station2 ).</syntaxhighlight> ====friends_can_meet( +Station1, +Station2 )==== holds when <var>Station1</var> and <var>Station2</var> have a common destination. <syntaxhighlight lang="prolog">friends_can_meet( Station1, Station2 ) :- station_destinations( Station1, Destinations1 ), station_destinations( Station2, Destinations2 ), member( MeetingPoint, Destinations1 ), member( MeetingPoint, Destinations2 ).</syntaxhighlight> ====network( +ZoomTracks, ?Destinations )==== holds when <var>ZoomTracks</var> is a set of Attraction &rarr; Destinations pairs describing a valid configuration of zoomtracks, such that each pair of attractions has exactly one destination in common. <var>Destinations</var> define the range of <var>ZoomTracks</var>. <syntaxhighlight lang="prolog">network( ZoomTracks, Destinations ) :- network1( ZoomTracks, Destinations, [] ). network1( [], Destinations, _Stations ) :- forall( member( Empty, Destinations ), Empty == [] ). network1( [Station|Stations], Destinations, Assigned ) :- destination_assignment( Station, Destinations, Destinations1 ), properly_connected( Station, Assigned ), network1( Stations, Destinations1, [Station|Assigned] ).</syntaxhighlight> ====destination_assignment( +Station, +Destinations, ?Destinations1 )==== holds when <var>Destinations1</var> is the difference of <var>Destinations</var> and the destinations of <var>Station</var>, which must not contain the origin of <var>Station</var>. <syntaxhighlight lang="prolog">destination_assignment( Station, Destinations0, Destinations1 ) :- station_destinations( Station, Destinations ), station_links( Station, Links ), matching( Destinations, Links, Destinations0, Destinations1 ).</syntaxhighlight> ====matching( +Destinations0, +Links, +Destinations1, ?Destinations2 )==== holds when <var>Destinations2</var> is the difference of <var>Destinations0</var> and <var>Destinations1</var>, and the <var>Links</var> variables corresponding to <var>Destinations0</var> are instantiated. <syntaxhighlight lang="prolog">matching( [], _Links, Destinations, Destinations ). matching( [Destination|Destinations], Links, Destinations0, [Rest|Destinations1] ) :- select( [Destination|Rest], Destinations0, Destinations2 ), link_receiver( Destination, Links, Destination ), matching( Destinations, Links, Destinations2, Destinations1 ).</syntaxhighlight> ====properly_connected( +Station, +Stations )==== holds when <var>Station</var> and each member of <var>Stations</var> have exactly one destination in common. <syntaxhighlight lang="prolog">properly_connected( Station, Stations ) :- station_destinations( Station, Destinations ), station_destinations( Station1, Destinations1 ), forall( member( Station1, Stations ), one_common_member( Destinations, Destinations1 ) ).</syntaxhighlight> ====one_common_member( ?Set0, ?Set1 )==== holds when <var>Set0</var> and <var>Set1</var> have exactly one common member. <syntaxhighlight lang="prolog">one_common_member( Set0, Set1 ) :- select( Member, Set0, Residue0 ), select( Member, Set1, Residue1 ), \+ common_member( Residue0, Residue1 ).</syntaxhighlight> ====common_member( ?Set0, ?Set1 )==== holds when <var>Set0</var> and <var>Set1</var> have a common member. <syntaxhighlight lang="prolog">common_member( Set0, Set1 ) :- member( Member, Set0 ), member( Member, Set1 ).</syntaxhighlight> === Data Abstraction === <syntaxhighlight lang="prolog">attraction( Name ) :- link_receiver( Name, _Links, _Value ). link_receiver( s, links( S,_U,_O,_N,_T,_P,_Q), S ). link_receiver( u, links(_S, U,_O,_N,_T,_P,_Q), U ). link_receiver( o, links(_S,_U, O,_N,_T,_P,_Q), O ). link_receiver( n, links(_S,_U,_O, N,_T,_P,_Q), N ). link_receiver( t, links(_S,_U,_O,_N, T,_P,_Q), T ). link_receiver( p, links(_S,_U,_O,_N,_T ,P,_Q), P ). link_receiver( q, links(_S,_U,_O,_N,_T,_P, Q), Q ). station_destinations( zoom(_Name, _Links, Destinations), Destinations ). station_links( zoom(_Name, Links, _Destinations), Links ). station_origin( zoom(Name, _Links, _Destinations), Name ).</syntaxhighlight> ==Utility Predicates== Load a small library of [[Puzzle Utilities]]. <syntaxhighlight lang="prolog"> :- ensure_loaded( misc ). </syntaxhighlight> ====print_zoom_tracks( +ZoomTracks )==== prints all the links in <var>ZoomTracks</var> as origin - destination pairs of stations. <syntaxhighlight lang="prolog">print_zoom_tracks( [] ). print_zoom_tracks( [ZoomTrack|ZoomTracks] ) :- station_origin( ZoomTrack, Origin ), station_destinations( ZoomTrack, Destinations ), print_zoom_track_links( Destinations, Origin ), print_zoom_tracks( ZoomTracks ). print_zoom_track_links( [], _Origin ). print_zoom_track_links( [Destination|Destinations], Origin ) :- format( '~w~w~n', [Origin,Destination] ), print_zoom_track_links( Destinations, Origin ).</syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/download/zoom_tracks.txt here]. ==Result== <pre class="Result">| ?- zoom. su so st uo un up ot on oq np nt ns tu tp tq pq ps po qs qu qn yes</pre> c9023a148775e1e559e5c05465360eee43196edf 127 113 2015-07-22T23:12:25Z John 2 Updated comp.lang.prolog link wikitext text/x-wiki __NOTOC__ <blockquote>Problem posted to [https://groups.google.com/forum/#!msg/comp.lang.prolog/kPfXFcAIBTk/0gYRo84wkSYJ comp.lang.prolog] by Paul Nothman: &ldquo;This problem was recently in a Mathematics competition. Although I completed it through logic and mathematics, without the aid of a computer, I'm wondering if and how it could be answered using prolog.&rdquo; </blockquote> == Problem Statement == The problem is as follows: World theme park has seven attractions which are so far apart that there needs to be a network of monorails, called zoomtracks, to transport the patrons between attractions. There is exactly one zoomtrack between each pair of attractions. Each zoomtrack can only transport patrons in one direction. The network is constructed so that two friends can always meet at a third attraction after exactly one trip each from any two attractions. Hint: Each attraction leads to and is led to by 3 other attractions. There are 21 zoomtracks altogether. Find the entire configuration of the theme park given the following: (The first letter of each line is the attraction from which the zoomtrack comes and the one beside it is where the zoomtrack leads to). SU SO ST UO UN UP OT ON NP TU == Solution Overview == An interesting aspect of this puzzle is the given partial solution. What is its purpose? Is it supposed to help or hinder? In fact, the partial solution allows relatively naive methods to find the right answer in reasonable time. However, I've chosen to implement a method that is not dependent on the partial solution. The key to this approach is the generation of the ''stations'' data-structures, which '''may''' be partially instantiated with the given solution, before the search for a complete solution begins. The requirements of the problem are that each attraction will have three destinations that can be reached by a single zoomtrack, and that every pair of attractions must have a destination in common. This solution uses the insight that every pair of attractions must have '''exactly one''' destination in common. ====zoom==== finds a solution and then prints it. <syntaxhighlight lang="prolog">zoom :- zoom_tracks( ZoomTracks ), print_zoom_tracks( ZoomTracks ).</syntaxhighlight> ====zoom_tracks( ?ZoomTracks )==== holds when <var>ZoomTracks</var> is a set of Attraction × Links × Destinations tuples, describing a valid configuration of zoomtracks, such that each pair of attractions has exactly one destination in common. The predicate network/2 always generates viable solutions, but a simple assertion is used to demonstrate that the solution is valid directly. <syntaxhighlight lang="prolog">zoom_tracks( ZoomTracks ) :- station_origin( Station, Attraction ), station_destinations( Station, Destinations ), length( Destinations, 3 ), findall( Station, attraction( Attraction ), ZoomTracks ), findall( [Dest,Dest,Dest], attraction( Dest ), PossibleDestinations ), unified_zoomtracks( ZoomTracks ), connections( ZoomTracks ), network( ZoomTracks, PossibleDestinations ), forall( pair_of_stations( ZoomTracks, Station1, Station2 ), friends_can_meet( Station1, Station2 ) ).</syntaxhighlight> ====unified_zoomtracks( +ZoomTracks )==== holds when <var>ZoomTracks</var> is a set of Attraction × Links × Destinations tuples such that each link between two Attractions is represented by a variable shared between the two attractions. In each tuple, the Link variable denoting the Attraction is bound to 'self'. <syntaxhighlight lang="prolog">unified_zoomtracks( ZoomTracks ) :- station_origin( First, Attraction1 ), station_origin( Second, Attraction2 ), findall( Attraction1-Attraction2, pair_of_stations(ZoomTracks, First, Second), Linkage ), unified_links( Linkage, ZoomTracks ).</syntaxhighlight> ====unified_links( +Linkage, +ZoomTracks )==== holds when <var>Linkage</var> is a list of Attraction1-Attraction2 pairs such that in <var>ZoomTracks</var>: * The link variables denoting Attraction1 for Attraction2 and vice versa are unified. * The link variables denoting Attraction1 for Attraction1 and Attraction2 for Attraction2 are bound to 'self'. <syntaxhighlight lang="prolog">unified_links( [], _ZoomTracks ). unified_links( [First-Second|Linkage], ZoomTracks ) :- station_origin( Station1, First ), station_links( Station1, Links1 ), station_origin( Station2, Second ), station_links( Station2, Links2 ), memberchk( Station1, ZoomTracks ), memberchk( Station2, ZoomTracks ), link_receiver( First, Links2, Receiver ), link_receiver( Second, Links1, Receiver ), link_receiver( First, Links1, self ), link_receiver( Second, Links2, self ), unified_links( Linkage, ZoomTracks ).</syntaxhighlight> ====connections( ?ZoomTracks )==== holds when the given connections have been applied to <var>ZoomTracks</var>. Note that this can be made vacuous without any significant effect on performance. <syntaxhighlight lang="prolog">connections( ZoomTracks ) :- connection( s, u, ZoomTracks ), connection( s, o, ZoomTracks ), connection( s, t, ZoomTracks ), connection( u, o, ZoomTracks ), connection( u, n, ZoomTracks ), connection( u, p, ZoomTracks ), connection( o, t, ZoomTracks ), connection( o, n, ZoomTracks ), connection( n, p, ZoomTracks ), connection( t, u, ZoomTracks ).</syntaxhighlight> ====connection( +Source, +Destination, +ZoomTracks )==== holds when <var>ZoomTracks</var> contains a connection from <var>Source</var> to <var>Destination</var>. <syntaxhighlight lang="prolog">connection( From, To, ZoomTracks ) :- station_origin( Station, From ), station_links( Station, Links ), station_destinations( Station, Destinations ), memberchk( Station, ZoomTracks ), memberchk( To, Destinations ), link_receiver( To, Links, To ).</syntaxhighlight> ====pair_of_stations( +ZoomTracks, ?Station1, ?Station2 )==== holds when <var>Station1</var> and <var>Station2</var> are distinct elements of <var>ZoomTracks</var>, avoiding redundant solutions. <syntaxhighlight lang="prolog">pair_of_stations( [Station1|ZoomTracks], Station1, Station2 ) :- member( Station2, ZoomTracks ). pair_of_stations( [_Station0|ZoomTracks], Station1, Station2 ) :- pair_of_stations( ZoomTracks, Station1, Station2 ).</syntaxhighlight> ====friends_can_meet( +Station1, +Station2 )==== holds when <var>Station1</var> and <var>Station2</var> have a common destination. <syntaxhighlight lang="prolog">friends_can_meet( Station1, Station2 ) :- station_destinations( Station1, Destinations1 ), station_destinations( Station2, Destinations2 ), member( MeetingPoint, Destinations1 ), member( MeetingPoint, Destinations2 ).</syntaxhighlight> ====network( +ZoomTracks, ?Destinations )==== holds when <var>ZoomTracks</var> is a set of Attraction &rarr; Destinations pairs describing a valid configuration of zoomtracks, such that each pair of attractions has exactly one destination in common. <var>Destinations</var> define the range of <var>ZoomTracks</var>. <syntaxhighlight lang="prolog">network( ZoomTracks, Destinations ) :- network1( ZoomTracks, Destinations, [] ). network1( [], Destinations, _Stations ) :- forall( member( Empty, Destinations ), Empty == [] ). network1( [Station|Stations], Destinations, Assigned ) :- destination_assignment( Station, Destinations, Destinations1 ), properly_connected( Station, Assigned ), network1( Stations, Destinations1, [Station|Assigned] ).</syntaxhighlight> ====destination_assignment( +Station, +Destinations, ?Destinations1 )==== holds when <var>Destinations1</var> is the difference of <var>Destinations</var> and the destinations of <var>Station</var>, which must not contain the origin of <var>Station</var>. <syntaxhighlight lang="prolog">destination_assignment( Station, Destinations0, Destinations1 ) :- station_destinations( Station, Destinations ), station_links( Station, Links ), matching( Destinations, Links, Destinations0, Destinations1 ).</syntaxhighlight> ====matching( +Destinations0, +Links, +Destinations1, ?Destinations2 )==== holds when <var>Destinations2</var> is the difference of <var>Destinations0</var> and <var>Destinations1</var>, and the <var>Links</var> variables corresponding to <var>Destinations0</var> are instantiated. <syntaxhighlight lang="prolog">matching( [], _Links, Destinations, Destinations ). matching( [Destination|Destinations], Links, Destinations0, [Rest|Destinations1] ) :- select( [Destination|Rest], Destinations0, Destinations2 ), link_receiver( Destination, Links, Destination ), matching( Destinations, Links, Destinations2, Destinations1 ).</syntaxhighlight> ====properly_connected( +Station, +Stations )==== holds when <var>Station</var> and each member of <var>Stations</var> have exactly one destination in common. <syntaxhighlight lang="prolog">properly_connected( Station, Stations ) :- station_destinations( Station, Destinations ), station_destinations( Station1, Destinations1 ), forall( member( Station1, Stations ), one_common_member( Destinations, Destinations1 ) ).</syntaxhighlight> ====one_common_member( ?Set0, ?Set1 )==== holds when <var>Set0</var> and <var>Set1</var> have exactly one common member. <syntaxhighlight lang="prolog">one_common_member( Set0, Set1 ) :- select( Member, Set0, Residue0 ), select( Member, Set1, Residue1 ), \+ common_member( Residue0, Residue1 ).</syntaxhighlight> ====common_member( ?Set0, ?Set1 )==== holds when <var>Set0</var> and <var>Set1</var> have a common member. <syntaxhighlight lang="prolog">common_member( Set0, Set1 ) :- member( Member, Set0 ), member( Member, Set1 ).</syntaxhighlight> === Data Abstraction === <syntaxhighlight lang="prolog">attraction( Name ) :- link_receiver( Name, _Links, _Value ). link_receiver( s, links( S,_U,_O,_N,_T,_P,_Q), S ). link_receiver( u, links(_S, U,_O,_N,_T,_P,_Q), U ). link_receiver( o, links(_S,_U, O,_N,_T,_P,_Q), O ). link_receiver( n, links(_S,_U,_O, N,_T,_P,_Q), N ). link_receiver( t, links(_S,_U,_O,_N, T,_P,_Q), T ). link_receiver( p, links(_S,_U,_O,_N,_T ,P,_Q), P ). link_receiver( q, links(_S,_U,_O,_N,_T,_P, Q), Q ). station_destinations( zoom(_Name, _Links, Destinations), Destinations ). station_links( zoom(_Name, Links, _Destinations), Links ). station_origin( zoom(Name, _Links, _Destinations), Name ).</syntaxhighlight> ==Utility Predicates== Load a small library of [[Puzzle Utilities]]. <syntaxhighlight lang="prolog"> :- ensure_loaded( misc ). </syntaxhighlight> ====print_zoom_tracks( +ZoomTracks )==== prints all the links in <var>ZoomTracks</var> as origin - destination pairs of stations. <syntaxhighlight lang="prolog">print_zoom_tracks( [] ). print_zoom_tracks( [ZoomTrack|ZoomTracks] ) :- station_origin( ZoomTrack, Origin ), station_destinations( ZoomTrack, Destinations ), print_zoom_track_links( Destinations, Origin ), print_zoom_tracks( ZoomTracks ). print_zoom_track_links( [], _Origin ). print_zoom_track_links( [Destination|Destinations], Origin ) :- format( '~w~w~n', [Origin,Destination] ), print_zoom_track_links( Destinations, Origin ).</syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/download/zoom_tracks.txt here]. ==Result== <pre class="Result">| ?- zoom. su so st uo un up ot on oq np nt ns tu tp tq pq ps po qs qu qn yes</pre> a753fdbd3f519640c79fb5a12475552bb1e78c0a 0 16 119 100 2015-06-10T22:10:18Z John 2 wikitext text/x-wiki __NOTOC__ <blockquote> &ldquo;I have a hard time arguing that anything in XML is generically useful any more except for the basic syntax, which lets us apply some very handy low-level tools like parsers and XSLT. The rest (XLink, schemas, etc.) has been a pointless trip into complexity.&rdquo; <cite>[http://lists.w3.org/Archives/Public/www-tag/2002Sep/0303.html Simon St.Laurent]</cite> </blockquote> <blockquote> &ldquo;My own experience is that having Prolog, Scheme, and Haskell available it'll take a gun pointed at my head or an extremely large bribe to make me use XSLT for anything.&rdquo; <cite>[http://clip.dia.fi.upm.es/Mail/ciao-users/2001/000207.html Richard A. O'Keefe]</cite> </blockquote> ==Background== xml.pl is a module for parsing XML with Prolog, which provides Prolog applications with a simple 'Document Value Model' interface to XML documents. It has been used successfully in a number of applications. It supports a subset of XML suitable for XML Data and Worldwide Web applications but it is neither as strict nor as comprehensive as the [http://www.w3.org/TR/2000/REC-xml-20001006 XML 1.0 Specification] mandates. * It is not as strict because, while the specification must eliminate ambiguities, not all errors need to be regarded as faults, and some reasonable examples of real XML usage would have to be rejected if they were. * It is not as comprehensive because, where the XML specification makes provision for more or less complete DTDs to be provided as part of a document, xml.pl actions the local definition of ENTITIES only. Other DTD extensions are treated as commentary. ===Download the [[XML Module]] (xml.pl and plxml)=== xml.pl and plxml, a small Windows application which embodies xml.pl, have been placed into the public domain to encourage the use of Prolog with XML. I hope that they will be useful to you, but they are not supported, and they are provided without any warranty of any kind. ==Specification== Three predicates are exported by the module: <code>xml_parse/[2,3]</code>, <code>xml_subterm/2</code> and <code>xml_pp/1</code> . ====xml_parse( {+Controls,} +?Chars, ?+Document )==== parses <var>Chars</var>, a list of character codes, to/from <var>Document</var>, a data structure of the form <code>xml(Attributes, Content)</code>, where: ''Attributes'' is a list of ''Name''=''CharData'' attributes from the (possibly implicit) XML signature of the document. ''Content'' is a (possibly empty) list comprising occurrences of: ; <code>pcdata(CharData)</code> : Text ; <code>comment(CharData)</code> : An XML comment; ; <code>namespace(URI, Prefix, Element)</code> : a Namespace ; <code>element(Tag, Attributes, Content)</code> : <Tag>..</Tag> encloses Content or <Tag/> if Content is empty <nowiki>[]</nowiki>. ; <code>instructions(Name, CharData)</code> : A PI <?Name CharData?> ; <code>cdata(CharData)</code> : <![CDATA[CharData]]> ; <code>doctype(Tag, DoctypeId)</code> : DTD <!DOCTYPE .. > The conversions are not completely symmetrical in that weaker XML is accepted than can be generated. Specifically, in-bound ''(Chars -> Document)'' parsing does not require strictly well-formed XML. If <var>Chars</var> does not represent well-formed XML, <var>Document</var> is instantiated to the term <code>malformed(Attributes, Content)</code> . The ''Content'' of a ''malformed/2'' structure can include: ; <code>unparsed( CharData )</code> : Text which has not been parsed ; <code>out_of_context(Tag)</code> : <Tag> is not closed in addition to the parsed-term types. Out-bound ''(<var>Document</var> -> <var>Chars</var>)'' parsing ''does'' require that <var>Document</var> defines well-formed XML. If an error is detected, a 'domain' exception is raised. The domain exception will attempt to identify the particular sub-term in error, and will list the ancestor elements of the sub-term in error as <code>Tag{(Id)}</code> terms - where ''Id'' is the value of any attribute named id. The <var>Controls</var> applying to in-bound ''(<var>Chars</var> -> <var>Document</var>)'' parsing are: ; <code>extended_characters(Boolean)</code> : Use the extended character entities for XHTML (default true). ; <code>format(Boolean)</code> : Remove layouts when no non-layout character data appears between elements (default true). ; <code>remove_attribute_prefixes(Boolean)</code> : Remove redundant prefixes from attributes - i.e. prefixes denoting the namespace of the parent element (default false). ; <code> allow_ampersand(Boolean) </code> : Allow unescaped ampersand characters (&) to occur in PCDATA (default false). For out-bound ''(<var>Document</var> -> <var>Chars</var>)'' parsing, the only available option is: ; <code>format(Boolean)</code> : Indent the element content, (default true) ===Types=== ; Tag : An atom naming an element ; Name : An atom, not naming an element ; URI : An atom giving the URI of a Namespace ; CharData : A "string": list of character codes. ; DoctypeId : one of: <code>public(CharData,&nbsp;CharData&nbsp;{,&nbsp;DTDLiterals})</code>, <code>system(CharData&nbsp;{,&nbsp;DTDLiterals})</code> or <code>local{(DTDLiterals)}</code> ; DTDLiterals : A non-empty list of <code>dtd_literal(CharData)</code> terms - e.g. [http://www.w3.org/TR/2000/REC-xml-20001006#NT-AttlistDecl attribute-list declarations]. ; Boolean : one of <code>true</code> or <code>false</code> ====xml_subterm( +XMLTerm, ?Subterm )==== unifies <var>Subterm</var> with a sub-term of <var>XMLTerm</var>. This can be especially useful when trying to test or retrieve a deeply-nested subterm from a document, as demonstrated in the [[XML Query Use Cases with xml.pl]] examples. Note that <var>XMLTerm</var> is a sub-term of itself. ====xml_pp( +XMLDocument )==== "pretty prints" <var>XMLDocument</var> on the current output stream. ==Availability== On this site, you can download the [[XML Module]]. The module is also supplied as a library with the following Prologs: * It has been adapted for the [http://logtalk.org/ Logtalk Open source object-oriented extension to Prolog] by Paulo Moura. (See the folder "contributions/xml_parser" from release 2.29.1); * It is available in the [http://eclipseclp.org/ ECLiPSe Constraint Programming System], as a third-party library; * It has been ported to [http://www.picat-lang.org/bprolog/ B-Prolog] by Neng-Fa Zhou. * It has been adapted for [http://sicstus.sics.se/thirdparty.html SICStus Prolog] by Mats Carlsson. * It is included in [http://quintus.sics.se/ Quintus Prolog Release 3.5]. [[XML Query Use Cases with xml.pl]] is provided as an example to illustrate the way that the code can be used. ==Features of xml.pl== The <code>xml/2</code> data structure has some useful properties. ===Reusability=== Using a native Prolog representation of XML, in which terms represent document 'nodes', makes the parser reusable for any XML application. In effect, xml.pl encapsulates the application-independent tasks of document parsing and generation, which is essential where documents have components from more than one Namespace. ===Same Structure=== The Prolog term representing a document has the same structure as the document itself, which makes the correspondence between the literal representation of the Prolog term and the XML source readily apparent. For example, this simple [http://www.w3.org/Graphics/SVG/ SVG] image: <syntaxhighlight lang="xml"> <?xml version="1.0" standalone="no"?> <!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.0//EN" "http://www.w3.org/.../svg10.dtd" [ <!ENTITY redblue "fill: red; stroke: blue; stroke-width: 1"> ]> <svg xmlns="http://www.w3.org/2000/svg" width="500" height="500"> <circle cx=" 25 " cy=" 25 " r=" 24 " style="&redblue;"/> </svg> </syntaxhighlight> ... translates into this Prolog term: <syntaxhighlight lang="prolog"> xml( [version="1.0", standalone="no"], [ doctype( svg, public( "-//W3C//DTD SVG 1.0//EN", "http://www.w3.org/.../svg10.dtd" ) ), namespace( 'http://www.w3.org/2000/svg', "", element( svg, [width="500", height="500"], [ element( circle, [cx="25", cy="25", r="24", style="fill: red; stroke: blue; stroke-width: 1"], [] ) ] ) ) ] ). </syntaxhighlight> ===Efficient Manipulation=== Each type of node in an XML document is represented by a different Prolog functor, while data, (PCDATA, CDATA and Attribute Values), are left as "strings", (lists of character codes). The use of distinct functors for mark-up structures enables the efficient recursive traversal of a document, while leaving the data as strings facilitates the application-specific parsing of data content (aka [http://www.google.com/search?q=%22Micro-parsing%22+XML Micro-parsing]). For example, to turn every CDATA node into a PCDATA node with tabs expanded into spaces: <syntaxhighlight lang="prolog"> cdata_to_pcdata( cdata(CharsWithTabs), pcdata(CharsWithSpaces) ) :- tab_expansion( CharsWithTabs, CharsWithSpaces ). cdata_to_pcdata( xml(Attributes, Content1), xml(Attributes, Content2) ) :- cdata_to_pcdata( Content1, Content2 ). cdata_to_pcdata( namespace(URI,Pfx,Content1), namespace(URI,Pfx,Content2) ) :- cdata_to_pcdata( Content1, Content2 ). cdata_to_pcdata( element(Name,Atts,Content1), element(Name,Atts,Content2) ) :- cdata_to_pcdata( Content1, Content2 ). cdata_to_pcdata( [], [] ). cdata_to_pcdata( [H1|T1], [H2|T2] ) :- cdata_to_pcdata( H1, H2 ), cdata_to_pcdata( T1, T2 ). cdata_to_pcdata( pcdata(Chars), pcdata(Chars) ). cdata_to_pcdata( comment(Chars), comment(Chars) ). cdata_to_pcdata( instructions(Name, Chars), instructions(Name, Chars) ). cdata_to_pcdata( doctype(Tag, DoctypeId), doctype(Tag, DoctypeId) ). </syntaxhighlight> The above uses no 'cuts', but will not create any choice points with ground input. ===Elegance=== The resolution of entity references and the decomposition of the document into distinct nodes means that the calling application is not concerned with the occasionally messy syntax of XML documents. For example, the clean separation of namespace nodes means that Namespaces, which are useful in combining specifications developed separately, have similar usefulness in combining applications developed separately. 4e2f6de2dc9d1fbaed4904825540bf8dc2dce9c2 120 119 2015-06-10T22:12:19Z John 2 /* xml_parse( {+Controls,} +?Chars, ?+Document ) */ wikitext text/x-wiki __NOTOC__ <blockquote> &ldquo;I have a hard time arguing that anything in XML is generically useful any more except for the basic syntax, which lets us apply some very handy low-level tools like parsers and XSLT. The rest (XLink, schemas, etc.) has been a pointless trip into complexity.&rdquo; <cite>[http://lists.w3.org/Archives/Public/www-tag/2002Sep/0303.html Simon St.Laurent]</cite> </blockquote> <blockquote> &ldquo;My own experience is that having Prolog, Scheme, and Haskell available it'll take a gun pointed at my head or an extremely large bribe to make me use XSLT for anything.&rdquo; <cite>[http://clip.dia.fi.upm.es/Mail/ciao-users/2001/000207.html Richard A. O'Keefe]</cite> </blockquote> ==Background== xml.pl is a module for parsing XML with Prolog, which provides Prolog applications with a simple 'Document Value Model' interface to XML documents. It has been used successfully in a number of applications. It supports a subset of XML suitable for XML Data and Worldwide Web applications but it is neither as strict nor as comprehensive as the [http://www.w3.org/TR/2000/REC-xml-20001006 XML 1.0 Specification] mandates. * It is not as strict because, while the specification must eliminate ambiguities, not all errors need to be regarded as faults, and some reasonable examples of real XML usage would have to be rejected if they were. * It is not as comprehensive because, where the XML specification makes provision for more or less complete DTDs to be provided as part of a document, xml.pl actions the local definition of ENTITIES only. Other DTD extensions are treated as commentary. ===Download the [[XML Module]] (xml.pl and plxml)=== xml.pl and plxml, a small Windows application which embodies xml.pl, have been placed into the public domain to encourage the use of Prolog with XML. I hope that they will be useful to you, but they are not supported, and they are provided without any warranty of any kind. ==Specification== Three predicates are exported by the module: <code>xml_parse/[2,3]</code>, <code>xml_subterm/2</code> and <code>xml_pp/1</code> . ====xml_parse( {+Controls,} +?Chars, ?+Document )==== parses <var>Chars</var>, a list of character codes, to/from <var>Document</var>, a data structure of the form <code>xml(Attributes, Content)</code>, where: ''Attributes'' is a list of ''Name''=''CharData'' attributes from the (possibly implicit) XML signature of the document. ''Content'' is a (possibly empty) list comprising occurrences of: ; <code>pcdata(CharData)</code> : Text ; <code>comment(CharData)</code> : An XML comment; ; <code>namespace(URI, Prefix, Element)</code> : a Namespace ; <code>element(Tag, Attributes, Content)</code> : <Tag>..</Tag> encloses Content or <Tag/> if Content is empty <nowiki>[]</nowiki>. ; <code>instructions(Name, CharData)</code> : A PI <?Name CharData?> ; <code>cdata(CharData)</code> : <![CDATA[CharData]]> ; <code>doctype(Tag, DoctypeId)</code> : DTD <!DOCTYPE .. > The conversions are not completely symmetrical in that weaker XML is accepted than can be generated. Specifically, in-bound ''(Chars -> Document)'' parsing does not require strictly well-formed XML. If <var>Chars</var> does not represent well-formed XML, <var>Document</var> is instantiated to the term <code>malformed(Attributes, Content)</code> . The ''Content'' of a ''malformed/2'' structure can include: ; <code>unparsed( CharData )</code> : Text which has not been parsed ; <code>out_of_context(Tag)</code> : <Tag> is not closed in addition to the parsed-term types. Out-bound ''(<var>Document</var> -> <var>Chars</var>)'' parsing ''does'' require that <var>Document</var> defines well-formed XML. If an error is detected, a 'domain' exception is raised. The domain exception will attempt to identify the particular sub-term in error, and will list the ancestor elements of the sub-term in error as <code>Tag{(Id)}</code> terms - where ''Id'' is the value of any attribute named id. The <var>Controls</var> applying to in-bound ''(<var>Chars</var> -> <var>Document</var>)'' parsing are: ; <code>extended_characters(Boolean)</code> : Use the extended character entities for XHTML (default true). ; <code>format(Boolean)</code> : Remove layouts when no non-layout character data appears between elements (default true). ; <code>remove_attribute_prefixes(Boolean)</code> : Remove redundant prefixes from attributes - i.e. prefixes denoting the namespace of the parent element (default false). ; <code> allow_ampersand(Boolean) </code> : Allow unescaped ampersand characters (&) to occur in PCDATA (default false). For out-bound ''(<var>Document</var> -> <var>Chars</var>)'' parsing, the only available option is: ; <code>format(Boolean)</code> : Indent the element content, (default true) ===Types=== ; Tag : An atom naming an element ; Name : An atom, not naming an element ; URI : An atom giving the URI of a Namespace ; CharData : A "string": list of character codes. ; DoctypeId : one of: <code>public(CharData,&nbsp;CharData&nbsp;{,&nbsp;DTDLiterals})</code>, <code>system(CharData&nbsp;{,&nbsp;DTDLiterals})</code> or <code>local{(DTDLiterals)}</code> ; DTDLiterals : A non-empty list of <code>dtd_literal(CharData)</code> terms - e.g. [http://www.w3.org/TR/2000/REC-xml-20001006#NT-AttlistDecl attribute-list declarations]. ; Boolean : one of <code>true</code> or <code>false</code> ====xml_subterm( +XMLTerm, ?Subterm )==== unifies <var>Subterm</var> with a sub-term of <var>XMLTerm</var>. This can be especially useful when trying to test or retrieve a deeply-nested subterm from a document, as demonstrated in the [[XML Query Use Cases with xml.pl]] examples. Note that <var>XMLTerm</var> is a sub-term of itself. ====xml_pp( +XMLDocument )==== "pretty prints" <var>XMLDocument</var> on the current output stream. ==Availability== On this site, you can download the [[XML Module]]. The module is also supplied as a library with the following Prologs: * It has been adapted for the [http://logtalk.org/ Logtalk Open source object-oriented extension to Prolog] by Paulo Moura. (See the folder "contributions/xml_parser" from release 2.29.1); * It is available in the [http://eclipseclp.org/ ECLiPSe Constraint Programming System], as a third-party library; * It has been ported to [http://www.picat-lang.org/bprolog/ B-Prolog] by Neng-Fa Zhou. * It has been adapted for [http://sicstus.sics.se/thirdparty.html SICStus Prolog] by Mats Carlsson. * It is included in [http://quintus.sics.se/ Quintus Prolog Release 3.5]. [[XML Query Use Cases with xml.pl]] is provided as an example to illustrate the way that the code can be used. ==Features of xml.pl== The <code>xml/2</code> data structure has some useful properties. ===Reusability=== Using a native Prolog representation of XML, in which terms represent document 'nodes', makes the parser reusable for any XML application. In effect, xml.pl encapsulates the application-independent tasks of document parsing and generation, which is essential where documents have components from more than one Namespace. ===Same Structure=== The Prolog term representing a document has the same structure as the document itself, which makes the correspondence between the literal representation of the Prolog term and the XML source readily apparent. For example, this simple [http://www.w3.org/Graphics/SVG/ SVG] image: <syntaxhighlight lang="xml"> <?xml version="1.0" standalone="no"?> <!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.0//EN" "http://www.w3.org/.../svg10.dtd" [ <!ENTITY redblue "fill: red; stroke: blue; stroke-width: 1"> ]> <svg xmlns="http://www.w3.org/2000/svg" width="500" height="500"> <circle cx=" 25 " cy=" 25 " r=" 24 " style="&redblue;"/> </svg> </syntaxhighlight> ... translates into this Prolog term: <syntaxhighlight lang="prolog"> xml( [version="1.0", standalone="no"], [ doctype( svg, public( "-//W3C//DTD SVG 1.0//EN", "http://www.w3.org/.../svg10.dtd" ) ), namespace( 'http://www.w3.org/2000/svg', "", element( svg, [width="500", height="500"], [ element( circle, [cx="25", cy="25", r="24", style="fill: red; stroke: blue; stroke-width: 1"], [] ) ] ) ) ] ). </syntaxhighlight> ===Efficient Manipulation=== Each type of node in an XML document is represented by a different Prolog functor, while data, (PCDATA, CDATA and Attribute Values), are left as "strings", (lists of character codes). The use of distinct functors for mark-up structures enables the efficient recursive traversal of a document, while leaving the data as strings facilitates the application-specific parsing of data content (aka [http://www.google.com/search?q=%22Micro-parsing%22+XML Micro-parsing]). For example, to turn every CDATA node into a PCDATA node with tabs expanded into spaces: <syntaxhighlight lang="prolog"> cdata_to_pcdata( cdata(CharsWithTabs), pcdata(CharsWithSpaces) ) :- tab_expansion( CharsWithTabs, CharsWithSpaces ). cdata_to_pcdata( xml(Attributes, Content1), xml(Attributes, Content2) ) :- cdata_to_pcdata( Content1, Content2 ). cdata_to_pcdata( namespace(URI,Pfx,Content1), namespace(URI,Pfx,Content2) ) :- cdata_to_pcdata( Content1, Content2 ). cdata_to_pcdata( element(Name,Atts,Content1), element(Name,Atts,Content2) ) :- cdata_to_pcdata( Content1, Content2 ). cdata_to_pcdata( [], [] ). cdata_to_pcdata( [H1|T1], [H2|T2] ) :- cdata_to_pcdata( H1, H2 ), cdata_to_pcdata( T1, T2 ). cdata_to_pcdata( pcdata(Chars), pcdata(Chars) ). cdata_to_pcdata( comment(Chars), comment(Chars) ). cdata_to_pcdata( instructions(Name, Chars), instructions(Name, Chars) ). cdata_to_pcdata( doctype(Tag, DoctypeId), doctype(Tag, DoctypeId) ). </syntaxhighlight> The above uses no 'cuts', but will not create any choice points with ground input. ===Elegance=== The resolution of entity references and the decomposition of the document into distinct nodes means that the calling application is not concerned with the occasionally messy syntax of XML documents. For example, the clean separation of namespace nodes means that Namespaces, which are useful in combining specifications developed separately, have similar usefulness in combining applications developed separately. 8bcf8d3d4371984333a51d926a3cace8b3c5c4cb 121 120 2015-06-10T22:13:41Z John 2 /* xml_parse( {+Controls,} +?Chars, ?+Document ) */ wikitext text/x-wiki __NOTOC__ <blockquote> &ldquo;I have a hard time arguing that anything in XML is generically useful any more except for the basic syntax, which lets us apply some very handy low-level tools like parsers and XSLT. The rest (XLink, schemas, etc.) has been a pointless trip into complexity.&rdquo; <cite>[http://lists.w3.org/Archives/Public/www-tag/2002Sep/0303.html Simon St.Laurent]</cite> </blockquote> <blockquote> &ldquo;My own experience is that having Prolog, Scheme, and Haskell available it'll take a gun pointed at my head or an extremely large bribe to make me use XSLT for anything.&rdquo; <cite>[http://clip.dia.fi.upm.es/Mail/ciao-users/2001/000207.html Richard A. O'Keefe]</cite> </blockquote> ==Background== xml.pl is a module for parsing XML with Prolog, which provides Prolog applications with a simple 'Document Value Model' interface to XML documents. It has been used successfully in a number of applications. It supports a subset of XML suitable for XML Data and Worldwide Web applications but it is neither as strict nor as comprehensive as the [http://www.w3.org/TR/2000/REC-xml-20001006 XML 1.0 Specification] mandates. * It is not as strict because, while the specification must eliminate ambiguities, not all errors need to be regarded as faults, and some reasonable examples of real XML usage would have to be rejected if they were. * It is not as comprehensive because, where the XML specification makes provision for more or less complete DTDs to be provided as part of a document, xml.pl actions the local definition of ENTITIES only. Other DTD extensions are treated as commentary. ===Download the [[XML Module]] (xml.pl and plxml)=== xml.pl and plxml, a small Windows application which embodies xml.pl, have been placed into the public domain to encourage the use of Prolog with XML. I hope that they will be useful to you, but they are not supported, and they are provided without any warranty of any kind. ==Specification== Three predicates are exported by the module: <code>xml_parse/[2,3]</code>, <code>xml_subterm/2</code> and <code>xml_pp/1</code> . ====xml_parse( {+Controls,} +?Chars, ?+Document )==== parses <var>Chars</var>, a list of character codes, to/from <var>Document</var>, a data structure of the form <code>xml(Attributes, Content)</code>, where: ''Attributes'' is a list of ''Name''=''CharData'' attributes from the (possibly implicit) XML signature of the document. ''Content'' is a (possibly empty) list comprising occurrences of: ; <code>pcdata(CharData)</code> : Text ; <code>comment(CharData)</code> : An XML comment; ; <code>namespace(URI, Prefix, Element)</code> : a Namespace ; <code>element(Tag, Attributes, Content)</code> : <Tag>..</Tag> encloses Content or <Tag/> if Content is empty <nowiki>[]</nowiki>. ; <code>instructions(Name, CharData)</code> : A PI <?Name CharData?> ; <code>cdata(CharData)</code> : <![CDATA[CharData]]> ; <code>doctype(Tag, DoctypeId)</code> : DTD <!DOCTYPE .. > The conversions are not completely symmetrical in that weaker XML is accepted than can be generated. Specifically, in-bound ''(Chars -> Document)'' parsing does not require strictly well-formed XML. If <var>Chars</var> does not represent well-formed XML, <var>Document</var> is instantiated to the term <code>malformed(Attributes, Content)</code>. The ''Content'' of a ''malformed/2'' structure can include: ; <code>unparsed( CharData )</code> : Text which has not been parsed ; <code>out_of_context(Tag)</code> : <Tag> is not closed in addition to the parsed-term types. Out-bound ''(<var>Document</var> -> <var>Chars</var>)'' parsing ''does'' require that <var>Document</var> defines well-formed XML. If an error is detected, a 'domain' exception is raised. The domain exception will attempt to identify the particular sub-term in error, and will list the ancestor elements of the sub-term in error as <code>Tag{(Id)}</code> terms - where ''Id'' is the value of any attribute named id. The <var>Controls</var> applying to in-bound ''(<var>Chars</var> -> <var>Document</var>)'' parsing are: ; <code>extended_characters(Boolean)</code> : Use the extended character entities for XHTML (default true). ; <code>format(Boolean)</code> : Remove layouts when no non-layout character data appears between elements (default true). ; <code>remove_attribute_prefixes(Boolean)</code> : Remove redundant prefixes from attributes - i.e. prefixes denoting the namespace of the parent element (default false). ; <code> allow_ampersand(Boolean) </code> : Allow unescaped ampersand characters (&) to occur in PCDATA (default false). For out-bound ''(<var>Document</var> -> <var>Chars</var>)'' parsing, the only available option is: ; <code>format(Boolean)</code> : Indent the element content, (default true) ===Types=== ; Tag : An atom naming an element ; Name : An atom, not naming an element ; URI : An atom giving the URI of a Namespace ; CharData : A "string": list of character codes. ; DoctypeId : one of: <code>public(CharData,&nbsp;CharData&nbsp;{,&nbsp;DTDLiterals})</code>, <code>system(CharData&nbsp;{,&nbsp;DTDLiterals})</code> or <code>local{(DTDLiterals)}</code> ; DTDLiterals : A non-empty list of <code>dtd_literal(CharData)</code> terms - e.g. [http://www.w3.org/TR/2000/REC-xml-20001006#NT-AttlistDecl attribute-list declarations]. ; Boolean : one of <code>true</code> or <code>false</code> ====xml_subterm( +XMLTerm, ?Subterm )==== unifies <var>Subterm</var> with a sub-term of <var>XMLTerm</var>. This can be especially useful when trying to test or retrieve a deeply-nested subterm from a document, as demonstrated in the [[XML Query Use Cases with xml.pl]] examples. Note that <var>XMLTerm</var> is a sub-term of itself. ====xml_pp( +XMLDocument )==== "pretty prints" <var>XMLDocument</var> on the current output stream. ==Availability== On this site, you can download the [[XML Module]]. The module is also supplied as a library with the following Prologs: * It has been adapted for the [http://logtalk.org/ Logtalk Open source object-oriented extension to Prolog] by Paulo Moura. (See the folder "contributions/xml_parser" from release 2.29.1); * It is available in the [http://eclipseclp.org/ ECLiPSe Constraint Programming System], as a third-party library; * It has been ported to [http://www.picat-lang.org/bprolog/ B-Prolog] by Neng-Fa Zhou. * It has been adapted for [http://sicstus.sics.se/thirdparty.html SICStus Prolog] by Mats Carlsson. * It is included in [http://quintus.sics.se/ Quintus Prolog Release 3.5]. [[XML Query Use Cases with xml.pl]] is provided as an example to illustrate the way that the code can be used. ==Features of xml.pl== The <code>xml/2</code> data structure has some useful properties. ===Reusability=== Using a native Prolog representation of XML, in which terms represent document 'nodes', makes the parser reusable for any XML application. In effect, xml.pl encapsulates the application-independent tasks of document parsing and generation, which is essential where documents have components from more than one Namespace. ===Same Structure=== The Prolog term representing a document has the same structure as the document itself, which makes the correspondence between the literal representation of the Prolog term and the XML source readily apparent. For example, this simple [http://www.w3.org/Graphics/SVG/ SVG] image: <syntaxhighlight lang="xml"> <?xml version="1.0" standalone="no"?> <!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.0//EN" "http://www.w3.org/.../svg10.dtd" [ <!ENTITY redblue "fill: red; stroke: blue; stroke-width: 1"> ]> <svg xmlns="http://www.w3.org/2000/svg" width="500" height="500"> <circle cx=" 25 " cy=" 25 " r=" 24 " style="&redblue;"/> </svg> </syntaxhighlight> ... translates into this Prolog term: <syntaxhighlight lang="prolog"> xml( [version="1.0", standalone="no"], [ doctype( svg, public( "-//W3C//DTD SVG 1.0//EN", "http://www.w3.org/.../svg10.dtd" ) ), namespace( 'http://www.w3.org/2000/svg', "", element( svg, [width="500", height="500"], [ element( circle, [cx="25", cy="25", r="24", style="fill: red; stroke: blue; stroke-width: 1"], [] ) ] ) ) ] ). </syntaxhighlight> ===Efficient Manipulation=== Each type of node in an XML document is represented by a different Prolog functor, while data, (PCDATA, CDATA and Attribute Values), are left as "strings", (lists of character codes). The use of distinct functors for mark-up structures enables the efficient recursive traversal of a document, while leaving the data as strings facilitates the application-specific parsing of data content (aka [http://www.google.com/search?q=%22Micro-parsing%22+XML Micro-parsing]). For example, to turn every CDATA node into a PCDATA node with tabs expanded into spaces: <syntaxhighlight lang="prolog"> cdata_to_pcdata( cdata(CharsWithTabs), pcdata(CharsWithSpaces) ) :- tab_expansion( CharsWithTabs, CharsWithSpaces ). cdata_to_pcdata( xml(Attributes, Content1), xml(Attributes, Content2) ) :- cdata_to_pcdata( Content1, Content2 ). cdata_to_pcdata( namespace(URI,Pfx,Content1), namespace(URI,Pfx,Content2) ) :- cdata_to_pcdata( Content1, Content2 ). cdata_to_pcdata( element(Name,Atts,Content1), element(Name,Atts,Content2) ) :- cdata_to_pcdata( Content1, Content2 ). cdata_to_pcdata( [], [] ). cdata_to_pcdata( [H1|T1], [H2|T2] ) :- cdata_to_pcdata( H1, H2 ), cdata_to_pcdata( T1, T2 ). cdata_to_pcdata( pcdata(Chars), pcdata(Chars) ). cdata_to_pcdata( comment(Chars), comment(Chars) ). cdata_to_pcdata( instructions(Name, Chars), instructions(Name, Chars) ). cdata_to_pcdata( doctype(Tag, DoctypeId), doctype(Tag, DoctypeId) ). </syntaxhighlight> The above uses no 'cuts', but will not create any choice points with ground input. ===Elegance=== The resolution of entity references and the decomposition of the document into distinct nodes means that the calling application is not concerned with the occasionally messy syntax of XML documents. For example, the clean separation of namespace nodes means that Namespaces, which are useful in combining specifications developed separately, have similar usefulness in combining applications developed separately. 2dc31d539efbda5773cb33e5f5e6aebf94380927 0 18 122 86 2015-06-14T16:01:07Z John 2 wikitext text/x-wiki __NOTOC__ The following is a complete example to illustrate how the xml.pl module can be used. It exercises both the input and output parsing modes of <code>xml_parse/[2,3]</code>, and illustrates the use of <code>xml_subterm/2</code> to access the nodes of a &ldquo;document value model&rdquo;. It's written for Quintus Prolog, but should port to other Prologs easily. ====test( +QueryId )==== The <code>test/1</code> predicate is the entry-point of the program and executes a Prolog implementation of a Query from [http://www.w3.org/TR/xquery-use-cases/#xmp Use Case &ldquo;XMP&rdquo;: Experiences and Exemplars], in the W3C's XML Query Use Cases, which &ldquo;contains several example queries that illustrate requirements gathered from the database and document communities&rdquo;. <var>QueryId</var> is one of <code>q1</code>...<code>q12</code> selecting which of the 12 use cases is executed. The XML output is written to the file [QueryId].xml in the current directory. <code>xml_pp/1</code> is used to display the resulting &ldquo;document value model&rdquo; data-structures on the user output (stdout) stream. <syntaxhighlight lang="prolog">test( Query ) :- xml_query( Query, ResultElement ), % Parse output XML into the Output chars xml_parse( Output, xml([], [ResultElement]) ), absolute_file_name( Query, [extensions(xml)], OutputFile ), % Write OutputFile from the Output list of chars tell( OutputFile ), put_chars( Output ), told, % Pretty print OutputXML write( 'Output XML' ), nl, xml_pp( xml([], [ResultElement]) ).</syntaxhighlight> ====xml_query( +QueryNo, ?OutputXML )==== when <var>OutputXML</var> is an XML Document Value Model produced by running an example, identified by <var>QueryNo</var>, taken from the XML Query &ldquo;XMP&rdquo; use case. ===Q1=== List books published by Addison-Wesley after 1991, including their year and title. <syntaxhighlight lang="prolog">xml_query( q1, element(bib, [], Books) ) :- element_name( Title, title ), element_name( Publisher, publisher ), input_document( 'bib.xml', Bibliography ), findall( element(book, [year=Year], [Title]), ( xml_subterm( Bibliography, element(book, Attributes, Content) ), xml_subterm( Content, Publisher ), xml_subterm( Publisher, Text ), text_value( Text, "Addison-Wesley" ), member( year=Year, Attributes ), number_codes( YearNo, Year ), YearNo > 1991, xml_subterm( Content, Title ) ), Books ).</syntaxhighlight> ===Q2=== Create a flat list of all the title-author pairs, with each pair enclosed in a &ldquo;result&rdquo; element. <syntaxhighlight lang="prolog">xml_query( q2, element(results, [], Results) ) :- element_name( Title, title ), element_name( Author, author ), element_name( Book, book ), input_document( 'bib.xml', Bibliography ), findall( element(result, [], [Title,Author]), ( xml_subterm( Bibliography, Book ), xml_subterm( Book, Title ), xml_subterm( Book, Author ) ), Results ).</syntaxhighlight> ===Q3=== For each book in the bibliography, list the title and authors, grouped inside a &ldquo;result&rdquo; element. <syntaxhighlight lang="prolog">xml_query( q3, element(results, [], Results) ) :- element_name( Title, title ), element_name( Author, author ), element_name( Book, book ), input_document( 'bib.xml', Bibliography ), findall( element(result, [], [Title|Authors]), ( xml_subterm( Bibliography, Book ), xml_subterm( Book, Title ), findall( Author, xml_subterm(Book, Author), Authors ) ), Results ).</syntaxhighlight> ===Q4=== For each author in the bibliography, list the author's name and the titles of all books by that author, grouped inside a &ldquo;result&rdquo; element. <syntaxhighlight lang="prolog">xml_query( q4, element(results, [], Results) ) :- element_name( Title, title ), element_name( Author, author ), element_name( Book, book ), input_document( 'bib.xml', Bibliography ), findall( Author, xml_subterm(Bibliography, Author), AuthorBag ), sort( AuthorBag, Authors ), findall( element(result, [], [Author|Titles]), ( member( Author, Authors ), findall( Title, ( xml_subterm( Bibliography, Book ), xml_subterm( Book, Author ), xml_subterm( Book, Title ) ), Titles ) ), Results ).</syntaxhighlight> ===Q5=== For each book found at both bn.com and amazon.com, list the title of the book and its price from each source. <syntaxhighlight lang="prolog">xml_query( q5, element('books-with-prices', [], BooksWithPrices) ) :- element_name( Title, title ), element_name( Book, book ), element_name( Review, entry ), input_document( 'bib.xml', Bibliography ), input_document( 'reviews.xml', Reviews ), findall( element('book-with-prices', [], [ Title, element('price-bn',[], BNPrice ), element('price-amazon',[], AmazonPrice ) ] ), ( xml_subterm( Bibliography, Book ), xml_subterm( Book, Title ), xml_subterm( Reviews, Review ), xml_subterm( Review, Title ), xml_subterm( Book, element(price,_, BNPrice) ), xml_subterm( Review, element(price,_, AmazonPrice) ) ), BooksWithPrices ).</syntaxhighlight> ===Q6=== For each book that has at least one author, list the title and first two authors, and an empty &ldquo;et-al&rdquo; element if the book has additional authors. <syntaxhighlight lang="prolog">xml_query( q6, element(bib, [], Results) ) :- element_name( Title, title ), element_name( Author, author ), element_name( Book, book ), input_document( 'bib.xml', Bibliography ), findall( element(book, [], [Title,FirstAuthor|Authors]), ( xml_subterm( Bibliography, Book ), xml_subterm( Book, Title ), findall( Author, xml_subterm(Book, Author), [FirstAuthor|Others] ), other_authors( Others, Authors ) ), Results ).</syntaxhighlight> ===Q7=== List the titles and years of all books published by Addison-Wesley after 1991, in alphabetic order. <syntaxhighlight lang="prolog">xml_query( q7, element(bib, [], Books) ) :- element_name( Title, title ), element_name( Publisher, publisher ), input_document( 'bib.xml', Bibliography ), findall( Title-element(book, [year=Year], [Title]), ( xml_subterm( Bibliography, element(book, Attributes, Book) ), xml_subterm( Book, Publisher ), xml_subterm( Publisher, Text ), text_value( Text, "Addison-Wesley" ), member( year=Year, Attributes ), number_codes( YearNo, Year ), YearNo > 1991, xml_subterm( Book, Title ) ), TitleBooks ), keysort( TitleBooks, TitleBookSet ), range( TitleBookSet, Books ).</syntaxhighlight> ===Q8=== Find books in which the name of some element ends with the string &ldquo;or&rdquo; and the same element contains the string &ldquo;Suciu&rdquo; somewhere in its content. For each such book, return the title and the qualifying element. <syntaxhighlight lang="prolog">xml_query( q8, element(bib, [], Books) ) :- element_name( Title, title ), element_name( Book, book ), element_name( QualifyingElement, QualifyingName ), append( "Suciu", _Back, Suffix ), input_document( 'bib.xml', Bibliography ), findall( element(book, [], [Title,QualifyingElement]), ( xml_subterm( Bibliography, Book ), xml_subterm( Book, QualifyingElement ), atom_codes( QualifyingName, QNChars ), append( _QNPrefix, "or", QNChars ), xml_subterm( QualifyingElement, TextItem ), text_value( TextItem, TextValue ), append( _Prefix, Suffix, TextValue ), xml_subterm( Book, Title ) ), Books ).</syntaxhighlight> ===Q9=== In the document &ldquo;books.xml&rdquo;, find all section or chapter titles that contain the word &ldquo;XML&rdquo;, regardless of the level of nesting. <syntaxhighlight lang="prolog">xml_query( q9, element(results, [], Titles) ) :- element_name( Title, title ), append( "XML", _Back, Suffix ), input_document( 'books.xml', Books ), findall( Title, ( xml_subterm( Books, Title ), xml_subterm( Title, TextItem ), text_value( TextItem, TextValue ), append( _Prefix, Suffix, TextValue ) ), Titles ).</syntaxhighlight> ===Q10=== In the document &ldquo;prices.xml&rdquo;, find the minimum price for each book, in the form of a &ldquo;minprice&rdquo; element with the book title as its title attribute. <syntaxhighlight lang="prolog">xml_query( q10, element(results, [], MinPrices) ) :- element_name( Title, title ), element_name( Price, price ), input_document( 'prices.xml', Prices ), findall( Title, xml_subterm(Prices, Title), TitleBag ), sort( TitleBag, TitleSet ), element_name( Book, book ), findall( element(minprice, [title=TitleString], [MinPrice]), ( member( Title, TitleSet ), xml_subterm( Title, TitleText ), text_value( TitleText, TitleString ), findall( PriceValue-Price, ( xml_subterm( Prices, Book ), xml_subterm( Book, Title ), xml_subterm( Book, Price ), xml_subterm( Price, Text ), text_value( Text, PriceChars ), number_codes( PriceValue, PriceChars ) ), PriceValues ), minimum( PriceValues, PriceValue-MinPrice ) ), MinPrices ).</syntaxhighlight> ===Q11=== For each book with an author, return the book with its title and authors. For each book with an editor, return a reference with the book title and the editor's affiliation. <syntaxhighlight lang="prolog">xml_query( q11, element(bib, [], Results) ) :- element_name( Title, title ), element_name( Author, author ), element_name( Book, book ), element_name( Editor, editor ), element_name( Affiliation, affiliation ), input_document( 'bib.xml', Bibliography ), findall( element(book, [], [Title,FirstAuthor|Authors]), ( xml_subterm( Bibliography, Book ), xml_subterm( Book, Title ), findall( Author, xml_subterm(Book, Author), [FirstAuthor|Authors] ) ), Books ), findall( element(reference, [], [Title,Affiliation]), ( xml_subterm( Bibliography, Book ), xml_subterm( Book, Title ), xml_subterm( Book, Editor ), xml_subterm( Editor, Affiliation ) ), References ), append( Books, References, Results ).</syntaxhighlight> ===Q12=== Find pairs of books that have different titles but the same set of authors (possibly in a different order). <syntaxhighlight lang="prolog">xml_query( q12, element(bib, [], Pairs) ) :- element_name( Author, author ), element_name( Book1, book ), element_name( Book2, book ), element_name( Title1, title ), element_name( Title2, title ), input_document( 'bib.xml', Bibliography ), findall( element('book-pair', [], [Title1,Title2]), ( xml_subterm( Bibliography, Book1 ), findall( Author, xml_subterm(Book1, Author), AuthorBag1 ), sort( AuthorBag1, AuthorSet ), xml_subterm( Bibliography, Book2 ), Book2 @< Book1, findall( Author, xml_subterm(Book2, Author), AuthorBag2 ), sort( AuthorBag2, AuthorSet ), xml_subterm( Book1, Title1 ), xml_subterm( Book2, Title2 ) ), Pairs ).</syntaxhighlight> == Auxiliary Predicates == <syntaxhighlight lang="prolog">other_authors( [], [] ). other_authors( [Author|Authors], [Author|EtAl] ) :- et_al( Authors, EtAl ). et_al( [], [] ). et_al( [_|_], [element('et-al',[],[])] ). text_value( [pcdata(Text)], Text ). text_value( [cdata(Text)], Text ). element_name( element(Name, _Attributes, _Content), Name ).</syntaxhighlight> ====range( +Pairs, ?Range )==== when <var>Pairs</var> is a list of key-datum pairs and <var>Range</var> is the list of data. <syntaxhighlight lang="prolog">range( [], [] ). range( [_Key-Datum|Pairs], [Datum|Data] ) :- range( Pairs, Data ).</syntaxhighlight> ====minimum( +List, ?Min )==== is true if <var>Min</var> is the least member of <var>List</var> in the standard order. <syntaxhighlight lang="prolog">minimum( [H|T], Min ):- minimum1( T, H, Min ). minimum1( [], Min, Min ). minimum1( [H|T], Min0, Min ) :- compare( Relation, H, Min0 ), minimum2( Relation, H, Min0, T, Min ). minimum2( '=', Min0, Min0, T, Min ) :- minimum1( T, Min0, Min ). minimum2( '<', Min0, _Min1, T, Min ) :- minimum1( T, Min0, Min ). minimum2( '>', _Min0, Min1, T, Min ) :- minimum1( T, Min1, Min ).</syntaxhighlight> ====input_document( +File, ?XML )==== reads <var>File</var> and parses the input into the &ldquo;Document Value Model&rdquo; <var>XML</var>. <syntaxhighlight lang="prolog">input_document( File, XML ) :- % Read InputFile as a list of chars see( File ), get_chars( Input ), seen, % Parse the Input chars into the term XML xml_parse( Input, XML ).</syntaxhighlight> Load the [[XML Module]]. <syntaxhighlight lang="prolog">:- use_module( xml ).</syntaxhighlight> Load a small library of [[Puzzle Utilities]]. <syntaxhighlight lang="prolog"> :- ensure_loaded( misc ). </syntaxhighlight> Download a 5Kb tar.gz format [https://binding-time.co.uk/download/xml_example.tar.gz file containing this program with input and output data]. 11d20d7cb4eeb1bacf16b85e50c0bb40a5e04861 0 15 128 67 2015-07-22T23:15:27Z John 2 Updated comp.lang.prolog link wikitext text/x-wiki __NOTOC__ ==Problem Statement== <blockquote><div>Problem posted to [https://groups.google.com/forum/#!msg/comp.lang.prolog/h2wy7VjCdEI/BzD3yB88K7oJ comp.lang.prolog] by Nimesh777@aol.com</div> M has been murdered. A, B and C are suspects. * A says he is innocent, B was M's friend but C hated M. * B says that he was out of town on the day of the murder, besides he didn't even know M. * C says he is innocent but he saw A &amp; B with M just before the murder. Assuming that all except possibly the murderer are telling the truth, solve the crime. </blockquote> ==Solution== <blockquote cite=""> When you have eliminated the impossible, whatever remains, however improbable, must be the truth. <cite>[http://www.gutenberg.org/ebooks/2097 Sir Arthur Conan Doyle - The Sign of the Four]</cite> </blockquote> ==== solve_murder( ?Murderer ) ==== Solving the crime means finding the <var>Murderer</var>'s identity, such that the <var>Murderer</var>'s statement is the only one that is inconsistent with the statements of the other suspects. <syntaxhighlight lang="prolog">solve_murder( Murderer ) :- unique_solution( murderer( Murderer ) ).</syntaxhighlight> Firstly, the suspects' statements are formalized: <syntaxhighlight lang="prolog">statement( a ) --> [innocent(a),friend(b,m),hates(c,m)]. statement( b ) --> [alibi(b),not_know(b,m)]. statement( c ) --> [innocent(c),with(c,m),with(b,m),with(a,m)]. statements( [] ) --> []. statements( [Witness|Witnesses] ) --> statement( Witness ), statements( Witnesses ).</syntaxhighlight> Then we define mutual-exclusivity between assertions. <syntaxhighlight lang="prolog">mutually_exclusive( [friend(X,Y), hates(X,Y), not_know(X,Y)] ). mutually_exclusive( [innocent(X), guilty(X)] ). mutually_exclusive( [alibi(X), with(X,m)] ). mutually_exclusive( [alibi(X), with(m,X)] ). mutually_exclusive( [alibi(X), guilty(X)] ).</syntaxhighlight> The murderer is identified by showing that the statements of the other suspects (witnesses) are consistent with each other, and with the murderer being guilty. <syntaxhighlight lang="prolog">murderer( Murderer ) :- Suspects = [a,b,c], select( Murderer, Suspects, Witnesses ), phrase( statements(Witnesses), Assertions ), consistent( [guilty(Murderer)|Assertions] ).</syntaxhighlight> A set of assertions is consistent if no inconsistency can be found between any member and the rest of the set. <syntaxhighlight lang="prolog">consistent( Statements ) :- \+ inconsistent( Statements ).</syntaxhighlight> An assertion is inconsistent with a set of assertions if it is pairwise exclusive with a member of the set. <syntaxhighlight lang="prolog">inconsistent( [Assertion|Assertions] ) :- mutually_exclusive( Exclusive ), select( Assertion, Exclusive, Inconsistent ), member( Inconsistency, Inconsistent ), member( Inconsistency, Assertions ). inconsistent( [_Assertion|Assertions] ) :- inconsistent( Assertions ).</syntaxhighlight> Load a small library of [[Puzzle Utilities]]. <syntaxhighlight lang="prolog"> :- ensure_loaded( misc ). </syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/download/whodunit.txt here]. ==Result== <pre>?- solve_murder( Murderer ). Murderer = b</pre> 191418b3ad82927d7bcf45d9adc06c66ec7e2aa0 0 22 130 2015-07-30T23:16:13Z John 2 Created page with "__NOTOC__ Out of the many Prolog programming books that I have read, I consider these to be the best. == Starting Out == Prolog is a deep subject, rather than a broad one, s..." wikitext text/x-wiki __NOTOC__ Out of the many Prolog programming books that I have read, I consider these to be the best. == Starting Out == Prolog is a deep subject, rather than a broad one, so it is best studied in stages. Clocksin &amp; Mellish's [http://www.amazon.co.uk/exec/obidos/ASIN/3540006788/bindingtimeli-21 Programming in Prolog] is the definitive introductory text on Prolog. Most importantly, it will help you to start programming straight away. == More Advanced Applications == I regard Peter Flach's [http://www.amazon.co.uk/exec/obidos/ASIN/0471941522/bindingtimeli-21 Simply Logical: Intelligent Reasoning by Example] as the best advanced text currently available. It deals with both theoretical and practical aspects of logic programming but doesn't assume prior knowledge beyond that you will have gained from &quot;Programming in Prolog&quot;. You can download the programs in the book, and the book as a <abbr title="Portable Document Format">PDF</abbr> file, from the [http://www.cs.bris.ac.uk/~flach/SimplyLogical.html Simply Logical page at Bristol University]. == The Last Word == Robert Kowalski's classic [http://www.amazon.co.uk/exec/obidos/ASIN/0444003681/bindingtimeli-21 Logic for Problem Solving] is essential reading for Prolog programmers. The book has been scanned into PDF format and can be downloaded from [http://www.doc.ic.ac.uk/~rak/ Robert Kowalski's homepage]. A recent revised edition, [http://www.amazon.co.uk/exec/obidos/ASIN/3837036294/bindingtimeli-21 Logic for Problem Solving, Revisited], is available. == Getting Technical == Performance and memory utilisation become important when Prolog is used to solve complex problems. David Harel's [http://www.amazon.co.uk/exec/obidos/ASIN/0201504014/bindingtimeli-21 Algorithmics] is a very accessible treatment of program behaviour. It isn't tied to one programming language, and the techniques described are readily applicable to Prolog programs. Richard O'Keefe's [http://www.amazon.co.uk/exec/obidos/ASIN/0262150395/bindingtimeli-21 The Craft of Prolog] is a superb exposition of the techniques that can be employed to work ''with'' Prolog, rather than fighting against it, and the rationale behind them. 10a750187e6ab7ecf8d73d5889e9db270d20e539 131 130 2015-07-30T23:19:30Z John 2 /* The Last Word */ wikitext text/x-wiki __NOTOC__ Out of the many Prolog programming books that I have read, I consider these to be the best. == Starting Out == Prolog is a deep subject, rather than a broad one, so it is best studied in stages. Clocksin &amp; Mellish's [http://www.amazon.co.uk/exec/obidos/ASIN/3540006788/bindingtimeli-21 Programming in Prolog] is the definitive introductory text on Prolog. Most importantly, it will help you to start programming straight away. == More Advanced Applications == I regard Peter Flach's [http://www.amazon.co.uk/exec/obidos/ASIN/0471941522/bindingtimeli-21 Simply Logical: Intelligent Reasoning by Example] as the best advanced text currently available. It deals with both theoretical and practical aspects of logic programming but doesn't assume prior knowledge beyond that you will have gained from &quot;Programming in Prolog&quot;. You can download the programs in the book, and the book as a <abbr title="Portable Document Format">PDF</abbr> file, from the [http://www.cs.bris.ac.uk/~flach/SimplyLogical.html Simply Logical page at Bristol University]. == The Last Word == Robert Kowalski's classic [http://www.amazon.co.uk/exec/obidos/ASIN/0444003681/bindingtimeli-21 Logic for Problem Solving] is essential reading for Prolog programmers. [http://www.amazon.co.uk/exec/obidos/ASIN/3837036294/bindingtimeli-21 Logic for Problem Solving, Revisited] is a recent revised edition. The original book has been scanned into PDF format and can be downloaded from [http://www.doc.ic.ac.uk/~rak/ Robert Kowalski's homepage]. == Getting Technical == Performance and memory utilisation become important when Prolog is used to solve complex problems. David Harel's [http://www.amazon.co.uk/exec/obidos/ASIN/0201504014/bindingtimeli-21 Algorithmics] is a very accessible treatment of program behaviour. It isn't tied to one programming language, and the techniques described are readily applicable to Prolog programs. Richard O'Keefe's [http://www.amazon.co.uk/exec/obidos/ASIN/0262150395/bindingtimeli-21 The Craft of Prolog] is a superb exposition of the techniques that can be employed to work ''with'' Prolog, rather than fighting against it, and the rationale behind them. 3a64ccd69170c7616c66a254a9614173b1971cb6 132 131 2015-07-30T23:59:25Z John 2 wikitext text/x-wiki __NOTOC__ Out of the many Prolog programming books that I have read, I consider these to be the best. == Starting Out == Prolog is a deep subject, rather than a broad one, so it is best studied in stages. Clocksin &amp; Mellish's [http://www.amazon.co.uk/exec/obidos/ASIN/3540006788/bindingtimeli-21 Programming in Prolog] is the definitive introductory text on Prolog. Most importantly, it will help you to start programming straight away. == More Advanced Applications == I regard Peter Flach's [http://www.amazon.co.uk/exec/obidos/ASIN/0471941522/bindingtimeli-21 Simply Logical: Intelligent Reasoning by Example] as the best advanced text currently available. It deals with both theoretical and practical aspects of logic programming but doesn't assume prior knowledge beyond that you will have gained from &quot;Programming in Prolog&quot;. You can download the programs in the book, and the book as a <abbr title="Portable Document Format">PDF</abbr> file, from the [http://www.cs.bris.ac.uk/~flach/SimplyLogical.html Simply Logical page at Bristol University]. == The Last Word == Robert Kowalski's classic [http://www.amazon.co.uk/exec/obidos/ASIN/0444003681/bindingtimeli-21 Logic for Problem Solving] is essential reading for Prolog programmers. [http://www.amazon.co.uk/exec/obidos/ASIN/3837036294/bindingtimeli-21 Logic for Problem Solving, Revisited] is a more recent, revised edition. The original book has been scanned into PDF format and can be downloaded from [http://www.doc.ic.ac.uk/~rak/ Robert Kowalski's homepage]. == Getting Technical == Performance and memory utilisation become important when Prolog is used to solve complex problems. David Harel's [http://www.amazon.co.uk/exec/obidos/ASIN/0201504014/bindingtimeli-21 Algorithmics] is a very accessible treatment of program behaviour. It isn't tied to one programming language, and the techniques described are readily applicable to Prolog programs. Richard O'Keefe's [http://www.amazon.co.uk/exec/obidos/ASIN/0262150395/bindingtimeli-21 The Craft of Prolog] is a superb exposition of the techniques that can be employed to work ''with'' Prolog, rather than fighting against it, and the rationale behind them. a21cca1b67a924ffe766ac9b7588b91964419a51 144 132 2016-04-18T23:04:45Z John 2 Some Amazon links updated wikitext text/x-wiki __NOTOC__ Out of the many Prolog programming books that I have read, I consider these to be the best. == Starting Out == Prolog is a deep subject, rather than a broad one, so it is best studied in stages. Clocksin &amp; Mellish's [https://www.amazon.co.uk/Programming-Prolog-Using-The-Iso-Standard/dp/3540006788/275-0042424-7481516?ie=UTF8&redirect=true&tag=bindingtimeli%2D21 Programming in Prolog] is the definitive introductory text on Prolog. Most importantly, it will help you to start programming straight away. == More Advanced Applications == I regard Peter Flach's [https://www.amazon.co.uk/Simply-Logical-Intelligent-Reasoning-Professional/dp/0471941522/278-2628466-8703061?ie=UTF8&redirect=true&tag=bindingtimeli%2D21 Simply Logical: Intelligent Reasoning by Example] as the best advanced text currently available. It deals with both theoretical and practical aspects of logic programming but doesn't assume prior knowledge beyond that you will have gained from &quot;Programming in Prolog&quot;. You can download the programs in the book, and the book as a <abbr title="Portable Document Format">PDF</abbr> file, from the [http://www.cs.bris.ac.uk/~flach/SimplyLogical.html Simply Logical page at Bristol University]. == The Last Word == Robert Kowalski's classic [http://www.amazon.co.uk/exec/obidos/ASIN/0444003681/bindingtimeli-21 Logic for Problem Solving] is essential reading for Prolog programmers. [http://www.amazon.co.uk/exec/obidos/ASIN/3837036294/bindingtimeli-21 Logic for Problem Solving, Revisited] is a more recent, revised edition. The original book has been scanned into PDF format and can be downloaded from [http://www.doc.ic.ac.uk/~rak/ Robert Kowalski's homepage]. == Getting Technical == Performance and memory utilisation become important when Prolog is used to solve complex problems. David Harel's [https://www.amazon.co.uk/Algorithmics-Spirit-Computing-David-Harel/dp/0201504014/277-9873726-9328265?ie=UTF8&redirect=true&tag=bindingtimeli%2D21 Algorithmics] is a very accessible treatment of program behaviour. It isn't tied to one programming language, and the techniques described are readily applicable to Prolog programs. Richard O'Keefe's [https://www.amazon.co.uk/The-Craft-PROLOG-Logic-Programming/dp/0262150395/279-6243224-4496947?ie=UTF8&redirect=true&tag=bindingtimeli%2D21 The Craft of Prolog] is a superb exposition of the techniques that can be employed to work ''with'' Prolog, rather than fighting against it, and the rationale behind them. 7d34ae240c9b064a577d8034fd805f5f04e000fd 146 144 2016-04-20T21:28:03Z John 2 Some more Amazon links updated wikitext text/x-wiki __NOTOC__ Out of the many Prolog programming books that I have read, I consider these to be the best. == Starting Out == Prolog is a deep subject, rather than a broad one, so it is best studied in stages. Clocksin &amp; Mellish's [https://www.amazon.co.uk/Programming-Prolog-Using-The-Iso-Standard/dp/3540006788/275-0042424-7481516?tag=bindingtimeli-21 Programming in Prolog] is the definitive introductory text on Prolog. Most importantly, it will help you to start programming straight away. == More Advanced Applications == I regard Peter Flach's [https://www.amazon.co.uk/Simply-Logical-Intelligent-Reasoning-Professional/dp/0471941522/278-2628466-8703061?tag=bindingtimeli-21 Simply Logical: Intelligent Reasoning by Example] as the best advanced text currently available. It deals with both theoretical and practical aspects of logic programming but doesn't assume prior knowledge beyond that you will have gained from &quot;Programming in Prolog&quot;. You can download the programs in the book, and the book as a <abbr title="Portable Document Format">PDF</abbr> file, from the [http://www.cs.bris.ac.uk/~flach/SimplyLogical.html Simply Logical page at Bristol University]. == The Last Word == Robert Kowalski's classic [https://www.amazon.co.uk/Logic-Problem-Solving-Robert-Kowalski/dp/0444003681/275-0829468-7451162?&tag=bindingtimeli-21 Logic for Problem Solving] is essential reading for Prolog programmers. [https://www.amazon.co.uk/Problem-Solving-Revisited-Robert-Kowalski/dp/3837036294/277-8538113-7135053?tag=bindingtimeli-21 Logic for Problem Solving, Revisited] is a more recent, revised edition. The original book has been scanned into PDF format and can be downloaded from [http://www.doc.ic.ac.uk/~rak/ Robert Kowalski's homepage]. == Getting Technical == Performance and memory utilisation become important when Prolog is used to solve complex problems. David Harel's [https://www.amazon.co.uk/Algorithmics-Spirit-Computing-David-Harel/dp/0201504014/277-9873726-9328265?tag=bindingtimeli-21 Algorithmics] is a very accessible treatment of program behaviour. It isn't tied to one programming language, and the techniques described are readily applicable to Prolog programs. Richard O'Keefe's [https://www.amazon.co.uk/The-Craft-PROLOG-Logic-Programming/dp/0262150395/279-6243224-4496947?tag=bindingtimeli-21 The Craft of Prolog] is a superb exposition of the techniques that can be employed to work ''with'' Prolog, rather than fighting against it, and the rationale behind them. f9758080e1f3edbfe441bf28f98d5512552a285b 4 21 134 85 2015-08-20T20:32:43Z John 2 /* Statement */ wikitext text/x-wiki == Statement == The following statement explains how your information will be treated as you make use of my web-site - binding-time.co.uk. It applies to all the public areas of the binding-time.co.uk web-site. binding-time.co.uk does not collect or store any information to identify you individually. The Mediawiki software used by binding-time.co.uk employs cookies for log in session management only. No other cookies are used by binding-time.co.uk. I am not responsible for the privacy practices of external web-sites. A link from binding-time.co.uk to an external site is not an endorsement of that site's privacy policy. == Information Collected == The data that is provided automatically by a browser is recorded in server logs and may be used for traffic analysis. This information includes: === User-Agent === Software programs that allow users to access documents on the World Wide Web are known as User-Agents. Typically these will be &quot;browsers&quot;, such as Mozilla Firefox or Microsoft Internet Explorer. Most User-Agents provide information about the type and version of both the user agent software and the operating system of the computer on which it runs. This information is provided automatically to every web-site the user visits. === IP Address === This is a unique numeric address assigned to each computer connected to the Internet and is provided automatically to every web-site the user visits. Usually, IP Addresses can be resolved to domain names, which may identify an Internet Service Provider (ISP), employer, university, etc. === Referrer === The referrer is the URL (address) of the page from which a request originated and is provided automatically by the User Agent (browser). 3537e33d1a10d18cadf579a2444b9d992a7230ed 0 20 135 79 2015-09-11T09:52:59Z John 2 wikitext text/x-wiki == Porting PiLLoW to Quintus Prolog 3.X == The [http://clip.dia.fi.upm.es/miscdocs/pillow/pillow.html PiLLoW] library provides predicates for developing HTTP client and server applications. For client applications, it provides mechanisms to retrieve HTML files and to parse HTML into useful Prolog terms. For server applications, it provides a predicate to access CGI query parameters, so that a Prolog application can be used to handle form input directly i.e. without additional scripting. Additionally, HTML parsing supports the reverse translation of terms into HTML, so that forms can be generated. ==PiLLoW 1.1== If you want to port [http://clip.dia.fi.upm.es/miscdocs/pillow/pillow.html PiLLoW 1.1] to [http://quintus.sics.se/ Quintus Prolog], the following notes may be of use. ===http_transaction/5=== must be rewritten to use the Quintus tcp and socketio libraries. ====http_transaction(+Host, +Port, +Request, +Timeout, -Response)==== Sends an HTTP <var>Request</var> to an HTTP server <var>Host</var>:<var>Port</var> and returns the resulting message in <var>Response</var>. <var>Timeout</var> defines the maximum number of seconds to wait for a response. <syntaxhighlight lang="prolog"> :- use_module(library(tcp)). :- use_module(library(socketio)). :- use_module(library(date), [now/1]). http_transaction( Host, Port, Request, Timeout, Response ) :- tcp:connect( Host, Port, Socket ), Socket >= 0, % Fail if connect error socket_io_open_output( Socket, Ocode ), stream_code( OStream, Ocode ), write_string( OStream, Request ), close( OStream ), socket_io_open_input( Socket, Icode ), stream_code( IStream, Icode ), now( Now ), http_transaction1( Now, Socket, IStream, Timeout, Response ), close( IStream ), tcp:tcp_shutdown( Socket, _Status ), Response \== timeout. http_transaction1( Now, Socket, IStream, Timeout, Response ) :- tcp:tcp_select( 0, Timeout, FD, Status ), http_transaction2( Status, Now, Socket, FD, IStream, Timeout, Response ). http_transaction2( 1, Then, Socket, FD, IStream, Timeout, Response ) :- ( Socket == FD -> stream_to_string( IStream, Response ) ; otherwise -> now( Now ), Elapsed is Now - Then, ( Elapsed < Timeout -> Timeout1 is Timeout - Elapsed, http_transaction1( Now, Socket, IStream, Timeout1, Response ) ; otherwise -> Response = timeout ) ). http_transaction2( 0, _Then, _Socket, _FD, _IStream, _Timeout, timeout ). http_transaction2( -1, _Then, Socket, _FD, IStream, Timeout, _Response ) :- raise_exception( socket_error(Socket, IStream, Timeout) ). getenvstr( Var, Chars ) :- environ( Var, Atom ), atom_chars( Atom, Chars ). :- use_module( library(environ), [environ/2] ). </syntaxhighlight> The ISO Prolog predicates used in PiLLoW can be mapped to equivalent Quintus built-in predicates. <syntaxhighlight lang="prolog">flush_output :- ttyflush. atom_codes( Atom, Codes ) :- atom_chars( Atom, Codes ). catch( Goal, Error, Action ) :- on_exception( Error, Goal, Action ). get_code( Code ) :- get0( Code ). get_code( Stream, Code ) :- get0( Stream, Code ). include( File ) :- ensure_loaded( File ). number_codes( Number, Codes ) :- number_chars( Number, Codes ). put_code( Code ) :- put( Code ).</syntaxhighlight> Similarly, some library predicates are not defined/defined differently in Quintus: <syntaxhighlight lang="prolog">atom_concat( A, B, AB ) :- name( A, AS ), name( B, BS ), append( AS, BS, ABS ), atom_chars( AB, ABS ). getenv( Var, QueryString ) :- environ( Var, QueryString ). :- use_module( library(environ), [environ/2] ).</syntaxhighlight> ==Pillow 1.0== I have ported PiLLoW 1.0 to use the [http://quintus.sics.se/ Quintus Prolog] 3.X libraries, and made it available as a [https://binding-time.co.uk/download/pillow.zip 260Kb Zip file]. It is offered here as free, '''unsupported''' source code, for which the author accepts no liability whatsoever. '''''Note:''''' The parsing of &quot;multipart&quot; form data on win32 can produce errors, when binary files are submitted, e.g. sending image files as part of the form input. This is because the default for &quot;stdin&quot; on win32 is &quot;text&quot;. 511022b9fe447ad0175670b1115a9e775d002a3d 0 17 141 83 2015-11-25T21:59:42Z John 2 /* Using plxml as a development tool */ wikitext text/x-wiki __NOTOC__ == Terms and Conditions == This program is offered free of charge as unsupported source code. You may use it, copy it, distribute it, modify it or sell it without restriction. I hope that it will be useful to you, but it is provided &quot;as is&quot; without any warranty express or implied, including but not limited to the warranty of non-infringement and the implied warranties of merchantability and fitness for a particular purpose. == Download == <pre>Current Version: 3.7 released 2014/07/09</pre> [https://binding-time.co.uk/download/xmlpl.tar.gz Download the source code] in tar.gz format (21KB) [https://binding-time.co.uk/download/xmlpl.zip Download the source code and Windows application] as a ZIP file (431KB) == Extracting the files == Unzip the files to create a folder structure as follows: <pre>+---bin | | plxml.exe : Application | | libpl.dll : Quintus Prolog support DLL | | libqp.dll : &quot; &quot; &quot; &quot; | | qpconsole.dll : &quot; &quot; &quot; &quot; | | qpeng.dll : &quot; &quot; &quot; &quot; | +---source | xml.pl : Quintus Prolog module wrapper | xml.iso.pl : ISO Prolog module wrapper | xml.lpa.pl : LPA Prolog wrapper | xml_driver.pl : Driver | xml_acquisition.pl : Chars -&gt; Document parsing | xml_generation.pl : Document -&gt; Chars parsing | xml_diagnosis.pl : Document -&gt; Chars parsing exception | xml_pp.pl : Document pretty-printing | xml_utilities.pl : Shared code</pre> == The Source Code (xml.pl) == xml is intended to be a modular module: it should be easy to build a program that can output XML, but not read it, or vice versa. Similarly, you may be happy to dispense with diagnosis once you are sure that your code will only try to make valid calls to xml_parse/2. It is intended that the code should be very portable too. Clearly, some small changes will be needed between platforms, but these should be limited to the top-level wrapper file which contains the potentially non-portable code. It is suggested that you name the wrapper file you need as xml.pl == Using plxml.exe == The application and the DLLs should reside in the same directory, unless you have a good reason to do something different. The application is invoked with two file names as operands, i.e. plxml [-(c|p|a)*] INPUT OUTPUT If INPUT contains a Prolog xml/2 clause, OUTPUT is written as the corresponding XML. If INPUT contains a Prolog malformed/2 clause, OUTPUT is written as the corresponding XML with the unparsed/1 and out_of_context/1 terms written as CDATA. If INPUT is an XML file, OUTPUT is written as a Prolog xml/2 or malformed/2 clause. INPUT and/or OUTPUT may be &quot;-&quot; indicating stdin/stdout respectively. ; The -a option : allows unescaped &amp; (ampersand) characters to occur in PCDATA - an increasingly common fault in the XML &quot;in the wild&quot;; ; The -p option : preserves whitespace; ; The -c option : causes prefixes to be removed from attribute names if the explicitly denoted namespace is that of the containing tag - i.e. is the namespace implicitly specified (XML input only); Plxml's Prolog output is compatible with [http://www.lpa.co.uk/ LPA Prolog]. Specifically, strings containing ~ (tilde) characters are output as lists of character codes. === Using plxml as a development tool === A common use of xml.pl is to populate template XML documents with answers from a Prolog application. A nice approach is to design a prototype document and then translate this into an xml/2 term with plxml. For example, a prototype HTML page could be produced with a WYSIWYG XHTML editor. Alternatively, if your editor produces plain HTML, you can use plxml in combination with [http://www.htacg.org/ HTML Tidy] e.g. tidy -asxhtml -ascii [HTMLFile] | plxml - [PLFile] Similarly, during prototyping/early development it may be convenient to use plxml as the interface, rather than integrating xml.pl itself. === Using plxml to repair XML === plxml can repair broken XML, sometimes: plxml -ac [Broken XML] - | plxml - [Fixed XML] === Character Encoding === By default, plxml can accept input encoded as UTF-8 or UTF-16, which encompasses plain 7-bit ASCII. The iso-8859-1, iso-8859-2, iso-8859-15 and windows-1252 8-bit encodings are supported, but they must be identified correctly in the signature of the XML document. xml.pl, (and therefore plxml), output a plain ASCII encoding with the following properties: * In all character data, the characters &amp; &lt; and &gt; are encoded as &amp;amp; &amp;lt; and &amp;gt; respectively. * In non-parsed character data, such as Attribute Values, the characters &quot; and ' are encoded as &amp;quot; and &amp;apos; respectively. * Any character codes &gt; 127 are output as decimal character entities e.g. 160 as &amp;#160;. * Only [http://www.w3.org/TR/2000/REC-xml-20001006#NT-Char character codes allowed by the XML specification] are encoded by xml_parse/[2,3]. aab2b7e285963a836d98d4e469138447cb9952d7 4 7 142 68 2015-12-17T22:46:48Z John 2 /* Why Wiki? */ wikitext text/x-wiki I am migrating my site to MediaWiki to make it easier to maintain. I hope that you like it. == Why Wiki? == MediaWiki makes it easy to incorporate computer code in web pages. Other sorts of markup can be generated automatically: <blockquote> "Features like site maps , breadcrumbs , and other structural elements must become browser commands. Extracting information space navigation from the website will liberate users from the whims of Web designers and ensure consistent and standardized navigation features. The Web's history has shown that people use generic commands like the Back button far more than intermittent features, which, when they are available -- and users can actually find them -- tend to look and work differently on different sites." <cite>From [https://www.nngroup.com/articles/time-to-make-tech-work/ Time to Make Tech Work Jakob Nielsen's Alertbox: September 15, 2003]</cite> </blockquote> ab84bcc1d2f90f5ebaee5ba891b6f7b79925d705 0 10 152 151 2016-05-14T23:46:24Z John 2 Generate layout from input drawing. wikitext text/x-wiki ;Constrained Permutations in Prolog __NOTOC__ Problem posted to [https://groups.google.com/forum/#!msg/comp.lang.prolog/e_-sEr4tuF4/gEEKXjLqhKkJ comp.lang.prolog] by Daniel Dudley ===Problem Statement=== <blockquote>A university was to hold an examination in 5 subjects: Norwegian, German, English, French and Spanish. In each of these languages there were 4 candidates. The examination room was therefore divided into 20 cells, as shown in the figure below (view this in a fixed font): <syntaxhighlight lang="prolog">figure( [" X ", " XXXXX", " XXXX ", " XXXX ", "XXXXX ", " X "] ).</syntaxhighlight> The university's administration wanted to secure themselves against cheating. Candidates in the same language were to be completely isolated from each other - so much so that their cells were not to coincide even at the corners. A young lecturer was given the job of finding a solution to the problem, which he did, and justly received a pat on the back from the dean. Now it just so happens that the dean is an ardent prolog programmer in his spare time (how else could he make dean?) and, realizing that there could be several solutions to the problem, used his skills to find all solutions. Can you do the same? </blockquote> ===Note=== &ldquo;Several solutions&rdquo; doesn't really cover it! Assuming that by &lsquo;a solution&rsquo; we mean finding a mapping between candidates and cells, then, having found one such solution, we can easily find 955,514,879 other members of its solution &ldquo;family&rdquo; through: * ''candidate permutation'': There are (4!)⁵ permutations of the candidates within the cells allocated to their subjects; * ''subject permutation'': we can multiply the candidate permutations by the 5! permutations of the subjects allocated to particular sets of cells. This means that the total number of solutions is 955514880 &times; D where D is the number of solution families i.e. solutions that cannot be derived from each other by candidate or subject permutation. Finding [[#Result|D]] is the more interesting problem solved by this program. ====nut1( ?Solutions )==== <var>Solutions</var> is the number of distinct solutions to the subject/cell allocation problem for any five different subjects. <syntaxhighlight lang="prolog">nut1( Solutions ) :- Norwegian = 1, German = 2, English = 3, French = 4, Spanish = 5, candidates( [Norwegian,German,English,French,Spanish], Candidates ), matrix( Cells ), count_solutions( allocate(Cells,Candidates), Solutions ).</syntaxhighlight> ====allocate( +Cells, +Candidates )==== holds when each cell in <var>Cells</var> holds a candidate from <var>Candidates</var>. <syntaxhighlight lang="prolog">allocate( Cells, Candidates ) :- allocation( Cells, 1, Candidates ).</syntaxhighlight> ====allocation( +Cells, +NextSubject, +Subjects )==== holds when <var>Cells</var> is a representation of a distinct solution to the subject/cell allocation problem. <var>NextSubject</var> is the highest subject that can be allocated next, while <var>Subjects</var> is the list of subjects needing allocation to <var>Cells</var>. Each subject is represented by a list, in which each occurrence of the subject number represents a candidate. We guarantee distinct solutions by ensuring that the allocation is made on the following basis: * For each subject: the location of the N+1th candidate must be a successor of the location of the Nth candidate - to eliminate candidate permutations. * The location of the first candidate of the N+1th subject must be a successor of the location of the first candidate of the Nth subject &ndash; to eliminate subject permutations. Operationally, at each step we select a candidate for a cell and constrain each of the cell's adjacent successors to have a different subject from it. <syntaxhighlight lang="prolog">allocation( [], _Next, [] ). allocation( [Cell|Cells], Next, Subjects ) :- allocate_candidate( Subjects, Next, Candidate, Subjects1, Next1 ), cell( Candidate, Cell ), adjacent_successors( Cell, AdjacentSuccessors ), blocked( AdjacentSuccessors, Candidate ), allocation( Cells, Next1, Subjects1 ).</syntaxhighlight> ====allocate_candidate( +Subjects, +Next, ?Candidate, ?Subjects1, ?Next1 )==== holds when <var>Candidate</var> is taken from <var>Subjects</var> leaving <var>Subjects1</var>. <var>Candidate</var> is represented by a subject number &le; <var>Next</var>. <var>Next1</var> is the highest subject that can be allocated to the next cell, ensuring that the first candidate for each subject is allocated in order. <syntaxhighlight lang="prolog">allocate_candidate( [Subject|Subjects], Next, Candidate, Subjects1, Next1 ) :- Subject = [Candidate|Candidates], Candidate =< Next, Next1 is max(Candidate+1,Next), residual_candidates( Candidates, Subjects, Subjects1 ). allocate_candidate( [Subject|Subjects], Next, Candidate, [Subject|Subjects1], Next1 ) :- Subject = [Candidate0|_Candidates], Candidate0 < Next, allocate_candidate( Subjects, Next, Candidate, Subjects1, Next1 ). residual_candidates( [], Subjects, Subjects ). residual_candidates( Candidates, Subjects, [Candidates|Subjects] ) :- Candidates = [_|_].</syntaxhighlight> ====matrix( ?Matrix )==== holds when <var>Matrix</var> is a list of cells ordered by their (x,y) coordinates. Each cell is described by 5 binary digits, which indicate the subject assigned to it, and the set of successors of the cell that are adjacent to it. <syntaxhighlight lang="prolog">matrix( Matrix ) :- layout( Layout ), matrix1( Layout, _Index, Matrix ). matrix1( [], _Index, [] ). matrix1( [(Row, Column)|Layout], Index, [Cell|Matrix] ) :- location_cell( Row, Column, Index, Cell ), findall( (Row1, Column1), ( successor( (Row, Column), (Row1, Column1) ), adjacent(Row, Row1), adjacent(Column, Column1) ), AdjacentSuccessorLocations ), location_cells( AdjacentSuccessorLocations, Index, AdjacentSuccessors ), adjacent_successors( Cell, AdjacentSuccessors ), matrix1( Layout, Index, Matrix ).</syntaxhighlight> ====cell( ?Subject, ?Cell )==== holds when <var>Cell</var> is the cell representation for <var>Subject</var>. <syntaxhighlight lang="prolog">cell( 1, cell(1,0,0,0,0,_) ). cell( 2, cell(0,1,0,0,0,_) ). cell( 3, cell(0,0,1,0,0,_) ). cell( 4, cell(0,0,0,1,0,_) ). cell( 5, cell(0,0,0,0,1,_) ).</syntaxhighlight> ====block( ?Subject, ?Block )==== holds when <var>Block</var> is a cell representation that is incompatible with <var>Subject</var>. <syntaxhighlight lang="prolog">block( 1, cell(0,_,_,_,_,_) ). block( 2, cell(_,0,_,_,_,_) ). block( 3, cell(_,_,0,_,_,_) ). block( 4, cell(_,_,_,0,_,_) ). block( 5, cell(_,_,_,_,0,_) ).</syntaxhighlight> ====adjacent_successors( ?Cell, ?AdjacentSuccesors )==== holds when <var>AdjacentSuccesors</var> is the set of successors of <var>Cell</var> that are adjacent to it. <syntaxhighlight lang="prolog">adjacent_successors( cell(_,_,_,_,_,AdjacentSuccesors), AdjacentSuccesors ).</syntaxhighlight> ====blocked( +Blocked, ?Subject )==== holds when all the cells in <var>Blocked</var> are incompatible with <var>Subject</var>. <syntaxhighlight lang="prolog">blocked( [], _Subject ). blocked( [Cell|Blocked], Subject ) :- block( Subject, Cell ), blocked( Blocked, Subject ).</syntaxhighlight> ====adjacent( +Coordinate0, ?Coordinate1 )==== holds when <var>Coordinate0</var> and <var>Coordinate1</var> are the same or differ by 1. <syntaxhighlight lang="prolog">adjacent( N, N ). adjacent( N0, N1 ) :- N1 is N0 + 1. adjacent( N0, N1 ) :- N1 is N0 - 1.</syntaxhighlight> ====location_cells( ?Locations, ?Index, ?Cells )==== holds when <var>Index</var> is a 6 &times; 6 array, <var>Locations</var> is a list of (Row,Column) pairs and <var>Cells</var> is the list of matching cells dereferenced from <var>Index</var>. <syntaxhighlight lang="prolog">location_cells( [], _Index, [] ). location_cells( [(Row, Column)|Locs], Index, [Cell|Cells] ) :- location_cell( Row, Column, Index, Cell ), location_cells( Locs, Index, Cells ).</syntaxhighlight> ====location_cell( ?Row, ?Column, ?Index, ?Cell )==== holds when <var>Index</var> is a 6 &times; 6 array with <var>Cell</var> at location (<var>Row</var>,<var>Column</var>). <syntaxhighlight lang="prolog">location_cell( Row, Column, Index, Cell ) :- select_nth( Row, Index, IndexRow ), select_nth( Column, IndexRow, Cell ).</syntaxhighlight> ====select_nth( ?N, ?Array, ?Element )==== holds when <var>Element</var> is the <var>N</var>th element of <var>Array</var>. <syntaxhighlight lang="prolog">select_nth( 1, array_6(A,_B,_C,_D,_E,_F), A ). select_nth( 2, array_6(_A,B,_C,_D,_E,_F), B ). select_nth( 3, array_6(_A,_B,C,_D,_E,_F), C ). select_nth( 4, array_6(_A,_B,_C,D,_E,_F), D ). select_nth( 5, array_6(_A,_B,_C,_D,E,_F), E ). select_nth( 6, array_6(_A,_B,_C,_D,_E,F), F ).</syntaxhighlight> ====successor( ?Coordinates0, ?Coordinates1 )==== holds when <var>Coordinates0</var> and <var>Coordinates1</var> are valid cell positions and <var>Coordinates0</var> &lt;<var>Coordinates1</var>. <syntaxhighlight lang="prolog">successor( Coordinates0, Coordinates1 ) :- layout( Layout ), append( _Prefix, [Coordinates0|Successors], Layout ), member( Coordinates1, Successors ).</syntaxhighlight> ====candidates( ?Subjects, ?Candidates )==== holds when there are 4 <var>Candidates</var> for each subject in <var>Subjects</var>. <syntaxhighlight lang="prolog">candidates( [], [] ). candidates( [Subj|Subjects], [[Subj,Subj,Subj,Subj]|Candidates] ) :- candidates( Subjects, Candidates ).</syntaxhighlight> ====layout( ?Layout )==== holds when Layout is the sequence of all (row,column) co-ordinates of defined cells. <syntaxhighlight lang="prolog">layout( OrderedLocations ) :- figure( Drawing ), findall( (Row,Column), (position(Cells, Drawing, Row), position(0'X, Cells, Column)), Locations ), sort( Locations, OrderedLocations ).</syntaxhighlight> ====position( +Element, +List, ?Position )==== When Element has Position in List. <syntaxhighlight lang="prolog">position( Element, List, Position ) :- position1( List, Element, 1, Position ). position1( [Element|_Rest], Element, N, N ). position1( [_Head|List], Element, N0, N1 ):- N2 is N0 + 1, position1( List, Element, N2, N1 ).</syntaxhighlight> Load a small library of [[Puzzle Utilities]]. <syntaxhighlight lang="prolog">:- ensure_loaded( misc ).</syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/download/nut1.txt here]. === Result === This program reports '''29870''' solutions. 47eb3132be89d0aed926839803be03305c117e0a 153 152 2016-05-14T23:52:09Z John 2 /* layout( ?Layout ) */ wikitext text/x-wiki ;Constrained Permutations in Prolog __NOTOC__ Problem posted to [https://groups.google.com/forum/#!msg/comp.lang.prolog/e_-sEr4tuF4/gEEKXjLqhKkJ comp.lang.prolog] by Daniel Dudley ===Problem Statement=== <blockquote>A university was to hold an examination in 5 subjects: Norwegian, German, English, French and Spanish. In each of these languages there were 4 candidates. The examination room was therefore divided into 20 cells, as shown in the figure below (view this in a fixed font): <syntaxhighlight lang="prolog">figure( [" X ", " XXXXX", " XXXX ", " XXXX ", "XXXXX ", " X "] ).</syntaxhighlight> The university's administration wanted to secure themselves against cheating. Candidates in the same language were to be completely isolated from each other - so much so that their cells were not to coincide even at the corners. A young lecturer was given the job of finding a solution to the problem, which he did, and justly received a pat on the back from the dean. Now it just so happens that the dean is an ardent prolog programmer in his spare time (how else could he make dean?) and, realizing that there could be several solutions to the problem, used his skills to find all solutions. Can you do the same? </blockquote> ===Note=== &ldquo;Several solutions&rdquo; doesn't really cover it! Assuming that by &lsquo;a solution&rsquo; we mean finding a mapping between candidates and cells, then, having found one such solution, we can easily find 955,514,879 other members of its solution &ldquo;family&rdquo; through: * ''candidate permutation'': There are (4!)⁵ permutations of the candidates within the cells allocated to their subjects; * ''subject permutation'': we can multiply the candidate permutations by the 5! permutations of the subjects allocated to particular sets of cells. This means that the total number of solutions is 955514880 &times; D where D is the number of solution families i.e. solutions that cannot be derived from each other by candidate or subject permutation. Finding [[#Result|D]] is the more interesting problem solved by this program. ====nut1( ?Solutions )==== <var>Solutions</var> is the number of distinct solutions to the subject/cell allocation problem for any five different subjects. <syntaxhighlight lang="prolog">nut1( Solutions ) :- Norwegian = 1, German = 2, English = 3, French = 4, Spanish = 5, candidates( [Norwegian,German,English,French,Spanish], Candidates ), matrix( Cells ), count_solutions( allocate(Cells,Candidates), Solutions ).</syntaxhighlight> ====allocate( +Cells, +Candidates )==== holds when each cell in <var>Cells</var> holds a candidate from <var>Candidates</var>. <syntaxhighlight lang="prolog">allocate( Cells, Candidates ) :- allocation( Cells, 1, Candidates ).</syntaxhighlight> ====allocation( +Cells, +NextSubject, +Subjects )==== holds when <var>Cells</var> is a representation of a distinct solution to the subject/cell allocation problem. <var>NextSubject</var> is the highest subject that can be allocated next, while <var>Subjects</var> is the list of subjects needing allocation to <var>Cells</var>. Each subject is represented by a list, in which each occurrence of the subject number represents a candidate. We guarantee distinct solutions by ensuring that the allocation is made on the following basis: * For each subject: the location of the N+1th candidate must be a successor of the location of the Nth candidate - to eliminate candidate permutations. * The location of the first candidate of the N+1th subject must be a successor of the location of the first candidate of the Nth subject &ndash; to eliminate subject permutations. Operationally, at each step we select a candidate for a cell and constrain each of the cell's adjacent successors to have a different subject from it. <syntaxhighlight lang="prolog">allocation( [], _Next, [] ). allocation( [Cell|Cells], Next, Subjects ) :- allocate_candidate( Subjects, Next, Candidate, Subjects1, Next1 ), cell( Candidate, Cell ), adjacent_successors( Cell, AdjacentSuccessors ), blocked( AdjacentSuccessors, Candidate ), allocation( Cells, Next1, Subjects1 ).</syntaxhighlight> ====allocate_candidate( +Subjects, +Next, ?Candidate, ?Subjects1, ?Next1 )==== holds when <var>Candidate</var> is taken from <var>Subjects</var> leaving <var>Subjects1</var>. <var>Candidate</var> is represented by a subject number &le; <var>Next</var>. <var>Next1</var> is the highest subject that can be allocated to the next cell, ensuring that the first candidate for each subject is allocated in order. <syntaxhighlight lang="prolog">allocate_candidate( [Subject|Subjects], Next, Candidate, Subjects1, Next1 ) :- Subject = [Candidate|Candidates], Candidate =< Next, Next1 is max(Candidate+1,Next), residual_candidates( Candidates, Subjects, Subjects1 ). allocate_candidate( [Subject|Subjects], Next, Candidate, [Subject|Subjects1], Next1 ) :- Subject = [Candidate0|_Candidates], Candidate0 < Next, allocate_candidate( Subjects, Next, Candidate, Subjects1, Next1 ). residual_candidates( [], Subjects, Subjects ). residual_candidates( Candidates, Subjects, [Candidates|Subjects] ) :- Candidates = [_|_].</syntaxhighlight> ====matrix( ?Matrix )==== holds when <var>Matrix</var> is a list of cells ordered by their (x,y) coordinates. Each cell is described by 5 binary digits, which indicate the subject assigned to it, and the set of successors of the cell that are adjacent to it. <syntaxhighlight lang="prolog">matrix( Matrix ) :- layout( Layout ), matrix1( Layout, _Index, Matrix ). matrix1( [], _Index, [] ). matrix1( [(Row, Column)|Layout], Index, [Cell|Matrix] ) :- location_cell( Row, Column, Index, Cell ), findall( (Row1, Column1), ( successor( (Row, Column), (Row1, Column1) ), adjacent(Row, Row1), adjacent(Column, Column1) ), AdjacentSuccessorLocations ), location_cells( AdjacentSuccessorLocations, Index, AdjacentSuccessors ), adjacent_successors( Cell, AdjacentSuccessors ), matrix1( Layout, Index, Matrix ).</syntaxhighlight> ====cell( ?Subject, ?Cell )==== holds when <var>Cell</var> is the cell representation for <var>Subject</var>. <syntaxhighlight lang="prolog">cell( 1, cell(1,0,0,0,0,_) ). cell( 2, cell(0,1,0,0,0,_) ). cell( 3, cell(0,0,1,0,0,_) ). cell( 4, cell(0,0,0,1,0,_) ). cell( 5, cell(0,0,0,0,1,_) ).</syntaxhighlight> ====block( ?Subject, ?Block )==== holds when <var>Block</var> is a cell representation that is incompatible with <var>Subject</var>. <syntaxhighlight lang="prolog">block( 1, cell(0,_,_,_,_,_) ). block( 2, cell(_,0,_,_,_,_) ). block( 3, cell(_,_,0,_,_,_) ). block( 4, cell(_,_,_,0,_,_) ). block( 5, cell(_,_,_,_,0,_) ).</syntaxhighlight> ====adjacent_successors( ?Cell, ?AdjacentSuccesors )==== holds when <var>AdjacentSuccesors</var> is the set of successors of <var>Cell</var> that are adjacent to it. <syntaxhighlight lang="prolog">adjacent_successors( cell(_,_,_,_,_,AdjacentSuccesors), AdjacentSuccesors ).</syntaxhighlight> ====blocked( +Blocked, ?Subject )==== holds when all the cells in <var>Blocked</var> are incompatible with <var>Subject</var>. <syntaxhighlight lang="prolog">blocked( [], _Subject ). blocked( [Cell|Blocked], Subject ) :- block( Subject, Cell ), blocked( Blocked, Subject ).</syntaxhighlight> ====adjacent( +Coordinate0, ?Coordinate1 )==== holds when <var>Coordinate0</var> and <var>Coordinate1</var> are the same or differ by 1. <syntaxhighlight lang="prolog">adjacent( N, N ). adjacent( N0, N1 ) :- N1 is N0 + 1. adjacent( N0, N1 ) :- N1 is N0 - 1.</syntaxhighlight> ====location_cells( ?Locations, ?Index, ?Cells )==== holds when <var>Index</var> is a 6 &times; 6 array, <var>Locations</var> is a list of (Row,Column) pairs and <var>Cells</var> is the list of matching cells dereferenced from <var>Index</var>. <syntaxhighlight lang="prolog">location_cells( [], _Index, [] ). location_cells( [(Row, Column)|Locs], Index, [Cell|Cells] ) :- location_cell( Row, Column, Index, Cell ), location_cells( Locs, Index, Cells ).</syntaxhighlight> ====location_cell( ?Row, ?Column, ?Index, ?Cell )==== holds when <var>Index</var> is a 6 &times; 6 array with <var>Cell</var> at location (<var>Row</var>,<var>Column</var>). <syntaxhighlight lang="prolog">location_cell( Row, Column, Index, Cell ) :- select_nth( Row, Index, IndexRow ), select_nth( Column, IndexRow, Cell ).</syntaxhighlight> ====select_nth( ?N, ?Array, ?Element )==== holds when <var>Element</var> is the <var>N</var>th element of <var>Array</var>. <syntaxhighlight lang="prolog">select_nth( 1, array_6(A,_B,_C,_D,_E,_F), A ). select_nth( 2, array_6(_A,B,_C,_D,_E,_F), B ). select_nth( 3, array_6(_A,_B,C,_D,_E,_F), C ). select_nth( 4, array_6(_A,_B,_C,D,_E,_F), D ). select_nth( 5, array_6(_A,_B,_C,_D,E,_F), E ). select_nth( 6, array_6(_A,_B,_C,_D,_E,F), F ).</syntaxhighlight> ====successor( ?Coordinates0, ?Coordinates1 )==== holds when <var>Coordinates0</var> and <var>Coordinates1</var> are valid cell positions and <var>Coordinates0</var> &lt;<var>Coordinates1</var>. <syntaxhighlight lang="prolog">successor( Coordinates0, Coordinates1 ) :- layout( Layout ), append( _Prefix, [Coordinates0|Successors], Layout ), member( Coordinates1, Successors ).</syntaxhighlight> ====candidates( ?Subjects, ?Candidates )==== holds when there are 4 <var>Candidates</var> for each subject in <var>Subjects</var>. <syntaxhighlight lang="prolog">candidates( [], [] ). candidates( [Subj|Subjects], [[Subj,Subj,Subj,Subj]|Candidates] ) :- candidates( Subjects, Candidates ).</syntaxhighlight> ====layout( ?Layout )==== holds when <var>Layout</var> is the sequence of all (row,column) co-ordinates of defined cells. <syntaxhighlight lang="prolog">layout( Layout ) :- figure( Drawing ), findall( (Row,Column), (position(Cells, Drawing, Row), position(0'X, Cells, Column)), Locations ), sort( Locations, Layout ).</syntaxhighlight> ====position( +Element, +List, ?Position )==== When Element has Position in List. <syntaxhighlight lang="prolog">position( Element, List, Position ) :- position1( List, Element, 1, Position ). position1( [Element|_Rest], Element, N, N ). position1( [_Head|List], Element, N0, N1 ):- N2 is N0 + 1, position1( List, Element, N2, N1 ).</syntaxhighlight> Load a small library of [[Puzzle Utilities]]. <syntaxhighlight lang="prolog">:- ensure_loaded( misc ).</syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/download/nut1.txt here]. === Result === This program reports '''29870''' solutions. 8ee3ee9ec93b5a7e613aeed052d77cdaf5abed8b 154 153 2016-05-14T23:53:25Z John 2 /* position( +Element, +List, ?Position ) */ wikitext text/x-wiki ;Constrained Permutations in Prolog __NOTOC__ Problem posted to [https://groups.google.com/forum/#!msg/comp.lang.prolog/e_-sEr4tuF4/gEEKXjLqhKkJ comp.lang.prolog] by Daniel Dudley ===Problem Statement=== <blockquote>A university was to hold an examination in 5 subjects: Norwegian, German, English, French and Spanish. In each of these languages there were 4 candidates. The examination room was therefore divided into 20 cells, as shown in the figure below (view this in a fixed font): <syntaxhighlight lang="prolog">figure( [" X ", " XXXXX", " XXXX ", " XXXX ", "XXXXX ", " X "] ).</syntaxhighlight> The university's administration wanted to secure themselves against cheating. Candidates in the same language were to be completely isolated from each other - so much so that their cells were not to coincide even at the corners. A young lecturer was given the job of finding a solution to the problem, which he did, and justly received a pat on the back from the dean. Now it just so happens that the dean is an ardent prolog programmer in his spare time (how else could he make dean?) and, realizing that there could be several solutions to the problem, used his skills to find all solutions. Can you do the same? </blockquote> ===Note=== &ldquo;Several solutions&rdquo; doesn't really cover it! Assuming that by &lsquo;a solution&rsquo; we mean finding a mapping between candidates and cells, then, having found one such solution, we can easily find 955,514,879 other members of its solution &ldquo;family&rdquo; through: * ''candidate permutation'': There are (4!)⁵ permutations of the candidates within the cells allocated to their subjects; * ''subject permutation'': we can multiply the candidate permutations by the 5! permutations of the subjects allocated to particular sets of cells. This means that the total number of solutions is 955514880 &times; D where D is the number of solution families i.e. solutions that cannot be derived from each other by candidate or subject permutation. Finding [[#Result|D]] is the more interesting problem solved by this program. ====nut1( ?Solutions )==== <var>Solutions</var> is the number of distinct solutions to the subject/cell allocation problem for any five different subjects. <syntaxhighlight lang="prolog">nut1( Solutions ) :- Norwegian = 1, German = 2, English = 3, French = 4, Spanish = 5, candidates( [Norwegian,German,English,French,Spanish], Candidates ), matrix( Cells ), count_solutions( allocate(Cells,Candidates), Solutions ).</syntaxhighlight> ====allocate( +Cells, +Candidates )==== holds when each cell in <var>Cells</var> holds a candidate from <var>Candidates</var>. <syntaxhighlight lang="prolog">allocate( Cells, Candidates ) :- allocation( Cells, 1, Candidates ).</syntaxhighlight> ====allocation( +Cells, +NextSubject, +Subjects )==== holds when <var>Cells</var> is a representation of a distinct solution to the subject/cell allocation problem. <var>NextSubject</var> is the highest subject that can be allocated next, while <var>Subjects</var> is the list of subjects needing allocation to <var>Cells</var>. Each subject is represented by a list, in which each occurrence of the subject number represents a candidate. We guarantee distinct solutions by ensuring that the allocation is made on the following basis: * For each subject: the location of the N+1th candidate must be a successor of the location of the Nth candidate - to eliminate candidate permutations. * The location of the first candidate of the N+1th subject must be a successor of the location of the first candidate of the Nth subject &ndash; to eliminate subject permutations. Operationally, at each step we select a candidate for a cell and constrain each of the cell's adjacent successors to have a different subject from it. <syntaxhighlight lang="prolog">allocation( [], _Next, [] ). allocation( [Cell|Cells], Next, Subjects ) :- allocate_candidate( Subjects, Next, Candidate, Subjects1, Next1 ), cell( Candidate, Cell ), adjacent_successors( Cell, AdjacentSuccessors ), blocked( AdjacentSuccessors, Candidate ), allocation( Cells, Next1, Subjects1 ).</syntaxhighlight> ====allocate_candidate( +Subjects, +Next, ?Candidate, ?Subjects1, ?Next1 )==== holds when <var>Candidate</var> is taken from <var>Subjects</var> leaving <var>Subjects1</var>. <var>Candidate</var> is represented by a subject number &le; <var>Next</var>. <var>Next1</var> is the highest subject that can be allocated to the next cell, ensuring that the first candidate for each subject is allocated in order. <syntaxhighlight lang="prolog">allocate_candidate( [Subject|Subjects], Next, Candidate, Subjects1, Next1 ) :- Subject = [Candidate|Candidates], Candidate =< Next, Next1 is max(Candidate+1,Next), residual_candidates( Candidates, Subjects, Subjects1 ). allocate_candidate( [Subject|Subjects], Next, Candidate, [Subject|Subjects1], Next1 ) :- Subject = [Candidate0|_Candidates], Candidate0 < Next, allocate_candidate( Subjects, Next, Candidate, Subjects1, Next1 ). residual_candidates( [], Subjects, Subjects ). residual_candidates( Candidates, Subjects, [Candidates|Subjects] ) :- Candidates = [_|_].</syntaxhighlight> ====matrix( ?Matrix )==== holds when <var>Matrix</var> is a list of cells ordered by their (x,y) coordinates. Each cell is described by 5 binary digits, which indicate the subject assigned to it, and the set of successors of the cell that are adjacent to it. <syntaxhighlight lang="prolog">matrix( Matrix ) :- layout( Layout ), matrix1( Layout, _Index, Matrix ). matrix1( [], _Index, [] ). matrix1( [(Row, Column)|Layout], Index, [Cell|Matrix] ) :- location_cell( Row, Column, Index, Cell ), findall( (Row1, Column1), ( successor( (Row, Column), (Row1, Column1) ), adjacent(Row, Row1), adjacent(Column, Column1) ), AdjacentSuccessorLocations ), location_cells( AdjacentSuccessorLocations, Index, AdjacentSuccessors ), adjacent_successors( Cell, AdjacentSuccessors ), matrix1( Layout, Index, Matrix ).</syntaxhighlight> ====cell( ?Subject, ?Cell )==== holds when <var>Cell</var> is the cell representation for <var>Subject</var>. <syntaxhighlight lang="prolog">cell( 1, cell(1,0,0,0,0,_) ). cell( 2, cell(0,1,0,0,0,_) ). cell( 3, cell(0,0,1,0,0,_) ). cell( 4, cell(0,0,0,1,0,_) ). cell( 5, cell(0,0,0,0,1,_) ).</syntaxhighlight> ====block( ?Subject, ?Block )==== holds when <var>Block</var> is a cell representation that is incompatible with <var>Subject</var>. <syntaxhighlight lang="prolog">block( 1, cell(0,_,_,_,_,_) ). block( 2, cell(_,0,_,_,_,_) ). block( 3, cell(_,_,0,_,_,_) ). block( 4, cell(_,_,_,0,_,_) ). block( 5, cell(_,_,_,_,0,_) ).</syntaxhighlight> ====adjacent_successors( ?Cell, ?AdjacentSuccesors )==== holds when <var>AdjacentSuccesors</var> is the set of successors of <var>Cell</var> that are adjacent to it. <syntaxhighlight lang="prolog">adjacent_successors( cell(_,_,_,_,_,AdjacentSuccesors), AdjacentSuccesors ).</syntaxhighlight> ====blocked( +Blocked, ?Subject )==== holds when all the cells in <var>Blocked</var> are incompatible with <var>Subject</var>. <syntaxhighlight lang="prolog">blocked( [], _Subject ). blocked( [Cell|Blocked], Subject ) :- block( Subject, Cell ), blocked( Blocked, Subject ).</syntaxhighlight> ====adjacent( +Coordinate0, ?Coordinate1 )==== holds when <var>Coordinate0</var> and <var>Coordinate1</var> are the same or differ by 1. <syntaxhighlight lang="prolog">adjacent( N, N ). adjacent( N0, N1 ) :- N1 is N0 + 1. adjacent( N0, N1 ) :- N1 is N0 - 1.</syntaxhighlight> ====location_cells( ?Locations, ?Index, ?Cells )==== holds when <var>Index</var> is a 6 &times; 6 array, <var>Locations</var> is a list of (Row,Column) pairs and <var>Cells</var> is the list of matching cells dereferenced from <var>Index</var>. <syntaxhighlight lang="prolog">location_cells( [], _Index, [] ). location_cells( [(Row, Column)|Locs], Index, [Cell|Cells] ) :- location_cell( Row, Column, Index, Cell ), location_cells( Locs, Index, Cells ).</syntaxhighlight> ====location_cell( ?Row, ?Column, ?Index, ?Cell )==== holds when <var>Index</var> is a 6 &times; 6 array with <var>Cell</var> at location (<var>Row</var>,<var>Column</var>). <syntaxhighlight lang="prolog">location_cell( Row, Column, Index, Cell ) :- select_nth( Row, Index, IndexRow ), select_nth( Column, IndexRow, Cell ).</syntaxhighlight> ====select_nth( ?N, ?Array, ?Element )==== holds when <var>Element</var> is the <var>N</var>th element of <var>Array</var>. <syntaxhighlight lang="prolog">select_nth( 1, array_6(A,_B,_C,_D,_E,_F), A ). select_nth( 2, array_6(_A,B,_C,_D,_E,_F), B ). select_nth( 3, array_6(_A,_B,C,_D,_E,_F), C ). select_nth( 4, array_6(_A,_B,_C,D,_E,_F), D ). select_nth( 5, array_6(_A,_B,_C,_D,E,_F), E ). select_nth( 6, array_6(_A,_B,_C,_D,_E,F), F ).</syntaxhighlight> ====successor( ?Coordinates0, ?Coordinates1 )==== holds when <var>Coordinates0</var> and <var>Coordinates1</var> are valid cell positions and <var>Coordinates0</var> &lt;<var>Coordinates1</var>. <syntaxhighlight lang="prolog">successor( Coordinates0, Coordinates1 ) :- layout( Layout ), append( _Prefix, [Coordinates0|Successors], Layout ), member( Coordinates1, Successors ).</syntaxhighlight> ====candidates( ?Subjects, ?Candidates )==== holds when there are 4 <var>Candidates</var> for each subject in <var>Subjects</var>. <syntaxhighlight lang="prolog">candidates( [], [] ). candidates( [Subj|Subjects], [[Subj,Subj,Subj,Subj]|Candidates] ) :- candidates( Subjects, Candidates ).</syntaxhighlight> ====layout( ?Layout )==== holds when <var>Layout</var> is the sequence of all (row,column) co-ordinates of defined cells. <syntaxhighlight lang="prolog">layout( Layout ) :- figure( Drawing ), findall( (Row,Column), (position(Cells, Drawing, Row), position(0'X, Cells, Column)), Locations ), sort( Locations, Layout ).</syntaxhighlight> ====position( +Element, +List, ?Position )==== When <var>Element</var> has <var>Position</var> in <var>List</var>. <syntaxhighlight lang="prolog">position( Element, List, Position ) :- position1( List, Element, 1, Position ). position1( [Element|_Rest], Element, N, N ). position1( [_Head|List], Element, N0, N1 ):- N2 is N0 + 1, position1( List, Element, N2, N1 ).</syntaxhighlight> Load a small library of [[Puzzle Utilities]]. <syntaxhighlight lang="prolog">:- ensure_loaded( misc ).</syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/download/nut1.txt here]. === Result === This program reports '''29870''' solutions. 8f260f0f6ffcab80d8b68ececb8d0312af9b4294 155 154 2016-05-15T16:53:22Z John 2 Problem Statement - reformat figure/1 clause. wikitext text/x-wiki ;Constrained Permutations in Prolog __NOTOC__ Problem posted to [https://groups.google.com/forum/#!msg/comp.lang.prolog/e_-sEr4tuF4/gEEKXjLqhKkJ comp.lang.prolog] by Daniel Dudley ===Problem Statement=== <blockquote>A university was to hold an examination in 5 subjects: Norwegian, German, English, French and Spanish. In each of these languages there were 4 candidates. The examination room was therefore divided into 20 cells, as shown in the figure below (view this in a fixed font): <syntaxhighlight lang="prolog">figure( [ " X ", " XXXXX", " XXXX ", " XXXX ", "XXXXX ", " X " ] ).</syntaxhighlight> The university's administration wanted to secure themselves against cheating. Candidates in the same language were to be completely isolated from each other - so much so that their cells were not to coincide even at the corners. A young lecturer was given the job of finding a solution to the problem, which he did, and justly received a pat on the back from the dean. Now it just so happens that the dean is an ardent prolog programmer in his spare time (how else could he make dean?) and, realizing that there could be several solutions to the problem, used his skills to find all solutions. Can you do the same? </blockquote> ===Note=== &ldquo;Several solutions&rdquo; doesn't really cover it! Assuming that by &lsquo;a solution&rsquo; we mean finding a mapping between candidates and cells, then, having found one such solution, we can easily find 955,514,879 other members of its solution &ldquo;family&rdquo; through: * ''candidate permutation'': There are (4!)⁵ permutations of the candidates within the cells allocated to their subjects; * ''subject permutation'': we can multiply the candidate permutations by the 5! permutations of the subjects allocated to particular sets of cells. This means that the total number of solutions is 955514880 &times; D where D is the number of solution families i.e. solutions that cannot be derived from each other by candidate or subject permutation. Finding [[#Result|D]] is the more interesting problem solved by this program. ====nut1( ?Solutions )==== <var>Solutions</var> is the number of distinct solutions to the subject/cell allocation problem for any five different subjects. <syntaxhighlight lang="prolog">nut1( Solutions ) :- Norwegian = 1, German = 2, English = 3, French = 4, Spanish = 5, candidates( [Norwegian,German,English,French,Spanish], Candidates ), matrix( Cells ), count_solutions( allocate(Cells,Candidates), Solutions ).</syntaxhighlight> ====allocate( +Cells, +Candidates )==== holds when each cell in <var>Cells</var> holds a candidate from <var>Candidates</var>. <syntaxhighlight lang="prolog">allocate( Cells, Candidates ) :- allocation( Cells, 1, Candidates ).</syntaxhighlight> ====allocation( +Cells, +NextSubject, +Subjects )==== holds when <var>Cells</var> is a representation of a distinct solution to the subject/cell allocation problem. <var>NextSubject</var> is the highest subject that can be allocated next, while <var>Subjects</var> is the list of subjects needing allocation to <var>Cells</var>. Each subject is represented by a list, in which each occurrence of the subject number represents a candidate. We guarantee distinct solutions by ensuring that the allocation is made on the following basis: * For each subject: the location of the N+1th candidate must be a successor of the location of the Nth candidate - to eliminate candidate permutations. * The location of the first candidate of the N+1th subject must be a successor of the location of the first candidate of the Nth subject &ndash; to eliminate subject permutations. Operationally, at each step we select a candidate for a cell and constrain each of the cell's adjacent successors to have a different subject from it. <syntaxhighlight lang="prolog">allocation( [], _Next, [] ). allocation( [Cell|Cells], Next, Subjects ) :- allocate_candidate( Subjects, Next, Candidate, Subjects1, Next1 ), cell( Candidate, Cell ), adjacent_successors( Cell, AdjacentSuccessors ), blocked( AdjacentSuccessors, Candidate ), allocation( Cells, Next1, Subjects1 ).</syntaxhighlight> ====allocate_candidate( +Subjects, +Next, ?Candidate, ?Subjects1, ?Next1 )==== holds when <var>Candidate</var> is taken from <var>Subjects</var> leaving <var>Subjects1</var>. <var>Candidate</var> is represented by a subject number &le; <var>Next</var>. <var>Next1</var> is the highest subject that can be allocated to the next cell, ensuring that the first candidate for each subject is allocated in order. <syntaxhighlight lang="prolog">allocate_candidate( [Subject|Subjects], Next, Candidate, Subjects1, Next1 ) :- Subject = [Candidate|Candidates], Candidate =< Next, Next1 is max(Candidate+1,Next), residual_candidates( Candidates, Subjects, Subjects1 ). allocate_candidate( [Subject|Subjects], Next, Candidate, [Subject|Subjects1], Next1 ) :- Subject = [Candidate0|_Candidates], Candidate0 < Next, allocate_candidate( Subjects, Next, Candidate, Subjects1, Next1 ). residual_candidates( [], Subjects, Subjects ). residual_candidates( Candidates, Subjects, [Candidates|Subjects] ) :- Candidates = [_|_].</syntaxhighlight> ====matrix( ?Matrix )==== holds when <var>Matrix</var> is a list of cells ordered by their (x,y) coordinates. Each cell is described by 5 binary digits, which indicate the subject assigned to it, and the set of successors of the cell that are adjacent to it. <syntaxhighlight lang="prolog">matrix( Matrix ) :- layout( Layout ), matrix1( Layout, _Index, Matrix ). matrix1( [], _Index, [] ). matrix1( [(Row, Column)|Layout], Index, [Cell|Matrix] ) :- location_cell( Row, Column, Index, Cell ), findall( (Row1, Column1), ( successor( (Row, Column), (Row1, Column1) ), adjacent(Row, Row1), adjacent(Column, Column1) ), AdjacentSuccessorLocations ), location_cells( AdjacentSuccessorLocations, Index, AdjacentSuccessors ), adjacent_successors( Cell, AdjacentSuccessors ), matrix1( Layout, Index, Matrix ).</syntaxhighlight> ====cell( ?Subject, ?Cell )==== holds when <var>Cell</var> is the cell representation for <var>Subject</var>. <syntaxhighlight lang="prolog">cell( 1, cell(1,0,0,0,0,_) ). cell( 2, cell(0,1,0,0,0,_) ). cell( 3, cell(0,0,1,0,0,_) ). cell( 4, cell(0,0,0,1,0,_) ). cell( 5, cell(0,0,0,0,1,_) ).</syntaxhighlight> ====block( ?Subject, ?Block )==== holds when <var>Block</var> is a cell representation that is incompatible with <var>Subject</var>. <syntaxhighlight lang="prolog">block( 1, cell(0,_,_,_,_,_) ). block( 2, cell(_,0,_,_,_,_) ). block( 3, cell(_,_,0,_,_,_) ). block( 4, cell(_,_,_,0,_,_) ). block( 5, cell(_,_,_,_,0,_) ).</syntaxhighlight> ====adjacent_successors( ?Cell, ?AdjacentSuccesors )==== holds when <var>AdjacentSuccesors</var> is the set of successors of <var>Cell</var> that are adjacent to it. <syntaxhighlight lang="prolog">adjacent_successors( cell(_,_,_,_,_,AdjacentSuccesors), AdjacentSuccesors ).</syntaxhighlight> ====blocked( +Blocked, ?Subject )==== holds when all the cells in <var>Blocked</var> are incompatible with <var>Subject</var>. <syntaxhighlight lang="prolog">blocked( [], _Subject ). blocked( [Cell|Blocked], Subject ) :- block( Subject, Cell ), blocked( Blocked, Subject ).</syntaxhighlight> ====adjacent( +Coordinate0, ?Coordinate1 )==== holds when <var>Coordinate0</var> and <var>Coordinate1</var> are the same or differ by 1. <syntaxhighlight lang="prolog">adjacent( N, N ). adjacent( N0, N1 ) :- N1 is N0 + 1. adjacent( N0, N1 ) :- N1 is N0 - 1.</syntaxhighlight> ====location_cells( ?Locations, ?Index, ?Cells )==== holds when <var>Index</var> is a 6 &times; 6 array, <var>Locations</var> is a list of (Row,Column) pairs and <var>Cells</var> is the list of matching cells dereferenced from <var>Index</var>. <syntaxhighlight lang="prolog">location_cells( [], _Index, [] ). location_cells( [(Row, Column)|Locs], Index, [Cell|Cells] ) :- location_cell( Row, Column, Index, Cell ), location_cells( Locs, Index, Cells ).</syntaxhighlight> ====location_cell( ?Row, ?Column, ?Index, ?Cell )==== holds when <var>Index</var> is a 6 &times; 6 array with <var>Cell</var> at location (<var>Row</var>,<var>Column</var>). <syntaxhighlight lang="prolog">location_cell( Row, Column, Index, Cell ) :- select_nth( Row, Index, IndexRow ), select_nth( Column, IndexRow, Cell ).</syntaxhighlight> ====select_nth( ?N, ?Array, ?Element )==== holds when <var>Element</var> is the <var>N</var>th element of <var>Array</var>. <syntaxhighlight lang="prolog">select_nth( 1, array_6(A,_B,_C,_D,_E,_F), A ). select_nth( 2, array_6(_A,B,_C,_D,_E,_F), B ). select_nth( 3, array_6(_A,_B,C,_D,_E,_F), C ). select_nth( 4, array_6(_A,_B,_C,D,_E,_F), D ). select_nth( 5, array_6(_A,_B,_C,_D,E,_F), E ). select_nth( 6, array_6(_A,_B,_C,_D,_E,F), F ).</syntaxhighlight> ====successor( ?Coordinates0, ?Coordinates1 )==== holds when <var>Coordinates0</var> and <var>Coordinates1</var> are valid cell positions and <var>Coordinates0</var> &lt;<var>Coordinates1</var>. <syntaxhighlight lang="prolog">successor( Coordinates0, Coordinates1 ) :- layout( Layout ), append( _Prefix, [Coordinates0|Successors], Layout ), member( Coordinates1, Successors ).</syntaxhighlight> ====candidates( ?Subjects, ?Candidates )==== holds when there are 4 <var>Candidates</var> for each subject in <var>Subjects</var>. <syntaxhighlight lang="prolog">candidates( [], [] ). candidates( [Subj|Subjects], [[Subj,Subj,Subj,Subj]|Candidates] ) :- candidates( Subjects, Candidates ).</syntaxhighlight> ====layout( ?Layout )==== holds when <var>Layout</var> is the sequence of all (row,column) co-ordinates of defined cells. <syntaxhighlight lang="prolog">layout( Layout ) :- figure( Drawing ), findall( (Row,Column), (position(Cells, Drawing, Row), position(0'X, Cells, Column)), Locations ), sort( Locations, Layout ).</syntaxhighlight> ====position( +Element, +List, ?Position )==== When <var>Element</var> has <var>Position</var> in <var>List</var>. <syntaxhighlight lang="prolog">position( Element, List, Position ) :- position1( List, Element, 1, Position ). position1( [Element|_Rest], Element, N, N ). position1( [_Head|List], Element, N0, N1 ):- N2 is N0 + 1, position1( List, Element, N2, N1 ).</syntaxhighlight> Load a small library of [[Puzzle Utilities]]. <syntaxhighlight lang="prolog">:- ensure_loaded( misc ).</syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/download/nut1.txt here]. === Result === This program reports '''29870''' solutions. a1885c53a009f2d102b5e85199c089144aaa0c62 156 155 2016-05-17T10:02:57Z John 2 /* matrix( ?Matrix ) */ row,column not x,y wikitext text/x-wiki ;Constrained Permutations in Prolog __NOTOC__ Problem posted to [https://groups.google.com/forum/#!msg/comp.lang.prolog/e_-sEr4tuF4/gEEKXjLqhKkJ comp.lang.prolog] by Daniel Dudley ===Problem Statement=== <blockquote>A university was to hold an examination in 5 subjects: Norwegian, German, English, French and Spanish. In each of these languages there were 4 candidates. The examination room was therefore divided into 20 cells, as shown in the figure below (view this in a fixed font): <syntaxhighlight lang="prolog">figure( [ " X ", " XXXXX", " XXXX ", " XXXX ", "XXXXX ", " X " ] ).</syntaxhighlight> The university's administration wanted to secure themselves against cheating. Candidates in the same language were to be completely isolated from each other - so much so that their cells were not to coincide even at the corners. A young lecturer was given the job of finding a solution to the problem, which he did, and justly received a pat on the back from the dean. Now it just so happens that the dean is an ardent prolog programmer in his spare time (how else could he make dean?) and, realizing that there could be several solutions to the problem, used his skills to find all solutions. Can you do the same? </blockquote> ===Note=== &ldquo;Several solutions&rdquo; doesn't really cover it! Assuming that by &lsquo;a solution&rsquo; we mean finding a mapping between candidates and cells, then, having found one such solution, we can easily find 955,514,879 other members of its solution &ldquo;family&rdquo; through: * ''candidate permutation'': There are (4!)⁵ permutations of the candidates within the cells allocated to their subjects; * ''subject permutation'': we can multiply the candidate permutations by the 5! permutations of the subjects allocated to particular sets of cells. This means that the total number of solutions is 955514880 &times; D where D is the number of solution families i.e. solutions that cannot be derived from each other by candidate or subject permutation. Finding [[#Result|D]] is the more interesting problem solved by this program. ====nut1( ?Solutions )==== <var>Solutions</var> is the number of distinct solutions to the subject/cell allocation problem for any five different subjects. <syntaxhighlight lang="prolog">nut1( Solutions ) :- Norwegian = 1, German = 2, English = 3, French = 4, Spanish = 5, candidates( [Norwegian,German,English,French,Spanish], Candidates ), matrix( Cells ), count_solutions( allocate(Cells,Candidates), Solutions ).</syntaxhighlight> ====allocate( +Cells, +Candidates )==== holds when each cell in <var>Cells</var> holds a candidate from <var>Candidates</var>. <syntaxhighlight lang="prolog">allocate( Cells, Candidates ) :- allocation( Cells, 1, Candidates ).</syntaxhighlight> ====allocation( +Cells, +NextSubject, +Subjects )==== holds when <var>Cells</var> is a representation of a distinct solution to the subject/cell allocation problem. <var>NextSubject</var> is the highest subject that can be allocated next, while <var>Subjects</var> is the list of subjects needing allocation to <var>Cells</var>. Each subject is represented by a list, in which each occurrence of the subject number represents a candidate. We guarantee distinct solutions by ensuring that the allocation is made on the following basis: * For each subject: the location of the N+1th candidate must be a successor of the location of the Nth candidate - to eliminate candidate permutations. * The location of the first candidate of the N+1th subject must be a successor of the location of the first candidate of the Nth subject &ndash; to eliminate subject permutations. Operationally, at each step we select a candidate for a cell and constrain each of the cell's adjacent successors to have a different subject from it. <syntaxhighlight lang="prolog">allocation( [], _Next, [] ). allocation( [Cell|Cells], Next, Subjects ) :- allocate_candidate( Subjects, Next, Candidate, Subjects1, Next1 ), cell( Candidate, Cell ), adjacent_successors( Cell, AdjacentSuccessors ), blocked( AdjacentSuccessors, Candidate ), allocation( Cells, Next1, Subjects1 ).</syntaxhighlight> ====allocate_candidate( +Subjects, +Next, ?Candidate, ?Subjects1, ?Next1 )==== holds when <var>Candidate</var> is taken from <var>Subjects</var> leaving <var>Subjects1</var>. <var>Candidate</var> is represented by a subject number &le; <var>Next</var>. <var>Next1</var> is the highest subject that can be allocated to the next cell, ensuring that the first candidate for each subject is allocated in order. <syntaxhighlight lang="prolog">allocate_candidate( [Subject|Subjects], Next, Candidate, Subjects1, Next1 ) :- Subject = [Candidate|Candidates], Candidate =< Next, Next1 is max(Candidate+1,Next), residual_candidates( Candidates, Subjects, Subjects1 ). allocate_candidate( [Subject|Subjects], Next, Candidate, [Subject|Subjects1], Next1 ) :- Subject = [Candidate0|_Candidates], Candidate0 < Next, allocate_candidate( Subjects, Next, Candidate, Subjects1, Next1 ). residual_candidates( [], Subjects, Subjects ). residual_candidates( Candidates, Subjects, [Candidates|Subjects] ) :- Candidates = [_|_].</syntaxhighlight> ====matrix( ?Matrix )==== holds when <var>Matrix</var> is a list of cells ordered by their row &times; column coordinates. Each cell is described by 5 binary digits, which indicate the subject assigned to it, and the set of successors of the cell that are adjacent to it. <syntaxhighlight lang="prolog">matrix( Matrix ) :- layout( Layout ), matrix1( Layout, _Index, Matrix ). matrix1( [], _Index, [] ). matrix1( [(Row, Column)|Layout], Index, [Cell|Matrix] ) :- location_cell( Row, Column, Index, Cell ), findall( (Row1, Column1), ( successor( (Row, Column), (Row1, Column1) ), adjacent(Row, Row1), adjacent(Column, Column1) ), AdjacentSuccessorLocations ), location_cells( AdjacentSuccessorLocations, Index, AdjacentSuccessors ), adjacent_successors( Cell, AdjacentSuccessors ), matrix1( Layout, Index, Matrix ).</syntaxhighlight> ====cell( ?Subject, ?Cell )==== holds when <var>Cell</var> is the cell representation for <var>Subject</var>. <syntaxhighlight lang="prolog">cell( 1, cell(1,0,0,0,0,_) ). cell( 2, cell(0,1,0,0,0,_) ). cell( 3, cell(0,0,1,0,0,_) ). cell( 4, cell(0,0,0,1,0,_) ). cell( 5, cell(0,0,0,0,1,_) ).</syntaxhighlight> ====block( ?Subject, ?Block )==== holds when <var>Block</var> is a cell representation that is incompatible with <var>Subject</var>. <syntaxhighlight lang="prolog">block( 1, cell(0,_,_,_,_,_) ). block( 2, cell(_,0,_,_,_,_) ). block( 3, cell(_,_,0,_,_,_) ). block( 4, cell(_,_,_,0,_,_) ). block( 5, cell(_,_,_,_,0,_) ).</syntaxhighlight> ====adjacent_successors( ?Cell, ?AdjacentSuccesors )==== holds when <var>AdjacentSuccesors</var> is the set of successors of <var>Cell</var> that are adjacent to it. <syntaxhighlight lang="prolog">adjacent_successors( cell(_,_,_,_,_,AdjacentSuccesors), AdjacentSuccesors ).</syntaxhighlight> ====blocked( +Blocked, ?Subject )==== holds when all the cells in <var>Blocked</var> are incompatible with <var>Subject</var>. <syntaxhighlight lang="prolog">blocked( [], _Subject ). blocked( [Cell|Blocked], Subject ) :- block( Subject, Cell ), blocked( Blocked, Subject ).</syntaxhighlight> ====adjacent( +Coordinate0, ?Coordinate1 )==== holds when <var>Coordinate0</var> and <var>Coordinate1</var> are the same or differ by 1. <syntaxhighlight lang="prolog">adjacent( N, N ). adjacent( N0, N1 ) :- N1 is N0 + 1. adjacent( N0, N1 ) :- N1 is N0 - 1.</syntaxhighlight> ====location_cells( ?Locations, ?Index, ?Cells )==== holds when <var>Index</var> is a 6 &times; 6 array, <var>Locations</var> is a list of (Row,Column) pairs and <var>Cells</var> is the list of matching cells dereferenced from <var>Index</var>. <syntaxhighlight lang="prolog">location_cells( [], _Index, [] ). location_cells( [(Row, Column)|Locs], Index, [Cell|Cells] ) :- location_cell( Row, Column, Index, Cell ), location_cells( Locs, Index, Cells ).</syntaxhighlight> ====location_cell( ?Row, ?Column, ?Index, ?Cell )==== holds when <var>Index</var> is a 6 &times; 6 array with <var>Cell</var> at location (<var>Row</var>,<var>Column</var>). <syntaxhighlight lang="prolog">location_cell( Row, Column, Index, Cell ) :- select_nth( Row, Index, IndexRow ), select_nth( Column, IndexRow, Cell ).</syntaxhighlight> ====select_nth( ?N, ?Array, ?Element )==== holds when <var>Element</var> is the <var>N</var>th element of <var>Array</var>. <syntaxhighlight lang="prolog">select_nth( 1, array_6(A,_B,_C,_D,_E,_F), A ). select_nth( 2, array_6(_A,B,_C,_D,_E,_F), B ). select_nth( 3, array_6(_A,_B,C,_D,_E,_F), C ). select_nth( 4, array_6(_A,_B,_C,D,_E,_F), D ). select_nth( 5, array_6(_A,_B,_C,_D,E,_F), E ). select_nth( 6, array_6(_A,_B,_C,_D,_E,F), F ).</syntaxhighlight> ====successor( ?Coordinates0, ?Coordinates1 )==== holds when <var>Coordinates0</var> and <var>Coordinates1</var> are valid cell positions and <var>Coordinates0</var> &lt;<var>Coordinates1</var>. <syntaxhighlight lang="prolog">successor( Coordinates0, Coordinates1 ) :- layout( Layout ), append( _Prefix, [Coordinates0|Successors], Layout ), member( Coordinates1, Successors ).</syntaxhighlight> ====candidates( ?Subjects, ?Candidates )==== holds when there are 4 <var>Candidates</var> for each subject in <var>Subjects</var>. <syntaxhighlight lang="prolog">candidates( [], [] ). candidates( [Subj|Subjects], [[Subj,Subj,Subj,Subj]|Candidates] ) :- candidates( Subjects, Candidates ).</syntaxhighlight> ====layout( ?Layout )==== holds when <var>Layout</var> is the sequence of all (row,column) co-ordinates of defined cells. <syntaxhighlight lang="prolog">layout( Layout ) :- figure( Drawing ), findall( (Row,Column), (position(Cells, Drawing, Row), position(0'X, Cells, Column)), Locations ), sort( Locations, Layout ).</syntaxhighlight> ====position( +Element, +List, ?Position )==== When <var>Element</var> has <var>Position</var> in <var>List</var>. <syntaxhighlight lang="prolog">position( Element, List, Position ) :- position1( List, Element, 1, Position ). position1( [Element|_Rest], Element, N, N ). position1( [_Head|List], Element, N0, N1 ):- N2 is N0 + 1, position1( List, Element, N2, N1 ).</syntaxhighlight> Load a small library of [[Puzzle Utilities]]. <syntaxhighlight lang="prolog">:- ensure_loaded( misc ).</syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/download/nut1.txt here]. === Result === This program reports '''29870''' solutions. cf26cec30d55a0b5c9ddfd0f097fa25cd2a56fbb 157 156 2016-05-18T22:37:29Z John 2 cells/1 replaces matrix/1. wikitext text/x-wiki ;Constrained Permutations in Prolog __NOTOC__ Problem posted to [https://groups.google.com/forum/#!msg/comp.lang.prolog/e_-sEr4tuF4/gEEKXjLqhKkJ comp.lang.prolog] by Daniel Dudley ===Problem Statement=== <blockquote>A university was to hold an examination in 5 subjects: Norwegian, German, English, French and Spanish. In each of these languages there were 4 candidates. The examination room was therefore divided into 20 cells, as shown in the figure below (view this in a fixed font): <syntaxhighlight lang="prolog">figure( [ " X ", " XXXXX", " XXXX ", " XXXX ", "XXXXX ", " X " ] ).</syntaxhighlight> The university's administration wanted to secure themselves against cheating. Candidates in the same language were to be completely isolated from each other - so much so that their cells were not to coincide even at the corners. A young lecturer was given the job of finding a solution to the problem, which he did, and justly received a pat on the back from the dean. Now it just so happens that the dean is an ardent prolog programmer in his spare time (how else could he make dean?) and, realizing that there could be several solutions to the problem, used his skills to find all solutions. Can you do the same? </blockquote> ===Note=== &ldquo;Several solutions&rdquo; doesn't really cover it! Assuming that by &lsquo;a solution&rsquo; we mean finding a mapping between candidates and cells, then, having found one such solution, we can easily find 955,514,879 other members of its solution &ldquo;family&rdquo; through: * ''candidate permutation'': There are (4!)⁵ permutations of the candidates within the cells allocated to their subjects; * ''subject permutation'': we can multiply the candidate permutations by the 5! permutations of the subjects allocated to particular sets of cells. This means that the total number of solutions is 955514880 &times; D where D is the number of solution families i.e. solutions that cannot be derived from each other by candidate or subject permutation. Finding [[#Result|D]] is the more interesting problem solved by this program. ====nut1( ?Solutions )==== <var>Solutions</var> is the number of distinct solutions to the subject/cell allocation problem for any five different subjects. <syntaxhighlight lang="prolog">nut1( Solutions ) :- Norwegian = 1, German = 2, English = 3, French = 4, Spanish = 5, candidates( [Norwegian,German,English,French,Spanish], Candidates ), matrix( Cells ), count_solutions( allocate(Cells,Candidates), Solutions ).</syntaxhighlight> ====allocate( +Cells, +Candidates )==== holds when each cell in <var>Cells</var> holds a candidate from <var>Candidates</var>. <syntaxhighlight lang="prolog">allocate( Cells, Candidates ) :- allocation( Cells, 1, Candidates ).</syntaxhighlight> ====allocation( +Cells, +NextSubject, +Subjects )==== holds when <var>Cells</var> is a representation of a distinct solution to the subject/cell allocation problem. <var>NextSubject</var> is the highest subject that can be allocated next, while <var>Subjects</var> is the list of subjects needing allocation to <var>Cells</var>. Each subject is represented by a list, in which each occurrence of the subject number represents a candidate. We guarantee distinct solutions by ensuring that the allocation is made on the following basis: * For each subject: the location of the N+1th candidate must be a successor of the location of the Nth candidate - to eliminate candidate permutations. * The location of the first candidate of the N+1th subject must be a successor of the location of the first candidate of the Nth subject &ndash; to eliminate subject permutations. Operationally, at each step we select a candidate for a cell and constrain each of the cell's adjacent successors to have a different subject from it. <syntaxhighlight lang="prolog">allocation( [], _Next, [] ). allocation( [Cell|Cells], Next, Subjects ) :- allocate_candidate( Subjects, Next, Candidate, Subjects1, Next1 ), cell( Candidate, Cell ), adjacent_successors( Cell, AdjacentSuccessors ), blocked( AdjacentSuccessors, Candidate ), allocation( Cells, Next1, Subjects1 ).</syntaxhighlight> ====allocate_candidate( +Subjects, +Next, ?Candidate, ?Subjects1, ?Next1 )==== holds when <var>Candidate</var> is taken from <var>Subjects</var> leaving <var>Subjects1</var>. <var>Candidate</var> is represented by a subject number &le; <var>Next</var>. <var>Next1</var> is the highest subject that can be allocated to the next cell, ensuring that the first candidate for each subject is allocated in order. <syntaxhighlight lang="prolog">allocate_candidate( [Subject|Subjects], Next, Candidate, Subjects1, Next1 ) :- Subject = [Candidate|Candidates], Candidate =< Next, Next1 is max(Candidate+1,Next), residual_candidates( Candidates, Subjects, Subjects1 ). allocate_candidate( [Subject|Subjects], Next, Candidate, [Subject|Subjects1], Next1 ) :- Subject = [Candidate0|_Candidates], Candidate0 < Next, allocate_candidate( Subjects, Next, Candidate, Subjects1, Next1 ). residual_candidates( [], Subjects, Subjects ). residual_candidates( Candidates, Subjects, [Candidates|Subjects] ) :- Candidates = [_|_].</syntaxhighlight> ====cells( ?Layout )==== holds when <var>Layout</var> is a list of cells ordered by their row &times; column coordinates. Each cell is described by 5 binary digits, which indicate the subject assigned to it, and the set of successors of the cell that are adjacent to it. <syntaxhighlight lang="prolog">cells( Layout ) :- findall( location_cell(Row,Column,_Cell), location(Row, Column), Cells ), sort( Cells, Ordered ), cells1( Ordered, Layout ). cells1( [], [] ). cells1( [location_cell(Row,Column,Cell)|Successors], [Cell|Matrix] ) :- adjacent_successors( Cell, AdjacentSuccessors ), cells2( Successors, Row, Column, AdjacentSuccessors ), cells1( Successors, Matrix ). cells2( [], _Row, _Column, [] ). cells2( [location_cell(Row1,Column1,Cell)|Layout], Row, Column, Adjacent ) :- ( adjacent( Row, Row1 ), adjacent( Column, Column1 ) -> Adjacent = [Cell|Adjacent1] ; otherwise -> Adjacent = Adjacent1 ), cells2( Layout, Row, Column, Adjacent1 ). ====cell( ?Subject, ?Cell )==== holds when <var>Cell</var> is the cell representation for <var>Subject</var>. <syntaxhighlight lang="prolog">cell( 1, cell(1,0,0,0,0,_) ). cell( 2, cell(0,1,0,0,0,_) ). cell( 3, cell(0,0,1,0,0,_) ). cell( 4, cell(0,0,0,1,0,_) ). cell( 5, cell(0,0,0,0,1,_) ).</syntaxhighlight> ====block( ?Subject, ?Block )==== holds when <var>Block</var> is a cell representation that is incompatible with <var>Subject</var>. <syntaxhighlight lang="prolog">block( 1, cell(0,_,_,_,_,_) ). block( 2, cell(_,0,_,_,_,_) ). block( 3, cell(_,_,0,_,_,_) ). block( 4, cell(_,_,_,0,_,_) ). block( 5, cell(_,_,_,_,0,_) ).</syntaxhighlight> ====adjacent_successors( ?Cell, ?AdjacentSuccesors )==== holds when <var>AdjacentSuccesors</var> is the set of successors of <var>Cell</var> that are adjacent to it. <syntaxhighlight lang="prolog">adjacent_successors( cell(_,_,_,_,_,AdjacentSuccesors), AdjacentSuccesors ).</syntaxhighlight> ====blocked( +Blocked, ?Subject )==== holds when all the cells in <var>Blocked</var> are incompatible with <var>Subject</var>. <syntaxhighlight lang="prolog">blocked( [], _Subject ). blocked( [Cell|Blocked], Subject ) :- block( Subject, Cell ), blocked( Blocked, Subject ).</syntaxhighlight> ====adjacent( +Coordinate0, ?Coordinate1 )==== holds when <var>Coordinate0</var> and <var>Coordinate1</var> are the same or differ by 1. <syntaxhighlight lang="prolog">adjacent( N, N ). adjacent( N0, N1 ) :- N1 is N0 + 1. adjacent( N0, N1 ) :- N1 is N0 - 1.</syntaxhighlight> ====location_cells( ?Locations, ?Index, ?Cells )==== holds when <var>Index</var> is a 6 &times; 6 array, <var>Locations</var> is a list of (Row,Column) pairs and <var>Cells</var> is the list of matching cells dereferenced from <var>Index</var>. <syntaxhighlight lang="prolog">location_cells( [], _Index, [] ). location_cells( [(Row, Column)|Locs], Index, [Cell|Cells] ) :- location_cell( Row, Column, Index, Cell ), location_cells( Locs, Index, Cells ).</syntaxhighlight> ====location_cell( ?Row, ?Column, ?Index, ?Cell )==== holds when <var>Index</var> is a 6 &times; 6 array with <var>Cell</var> at location (<var>Row</var>,<var>Column</var>). <syntaxhighlight lang="prolog">location_cell( Row, Column, Index, Cell ) :- select_nth( Row, Index, IndexRow ), select_nth( Column, IndexRow, Cell ).</syntaxhighlight> ====select_nth( ?N, ?Array, ?Element )==== holds when <var>Element</var> is the <var>N</var>th element of <var>Array</var>. <syntaxhighlight lang="prolog">select_nth( 1, array_6(A,_B,_C,_D,_E,_F), A ). select_nth( 2, array_6(_A,B,_C,_D,_E,_F), B ). select_nth( 3, array_6(_A,_B,C,_D,_E,_F), C ). select_nth( 4, array_6(_A,_B,_C,D,_E,_F), D ). select_nth( 5, array_6(_A,_B,_C,_D,E,_F), E ). select_nth( 6, array_6(_A,_B,_C,_D,_E,F), F ).</syntaxhighlight> ====successor( ?Coordinates0, ?Coordinates1 )==== holds when <var>Coordinates0</var> and <var>Coordinates1</var> are valid cell positions and <var>Coordinates0</var> &lt;<var>Coordinates1</var>. <syntaxhighlight lang="prolog">successor( Coordinates0, Coordinates1 ) :- layout( Layout ), append( _Prefix, [Coordinates0|Successors], Layout ), member( Coordinates1, Successors ).</syntaxhighlight> ====candidates( ?Subjects, ?Candidates )==== holds when there are 4 <var>Candidates</var> for each subject in <var>Subjects</var>. <syntaxhighlight lang="prolog">candidates( [], [] ). candidates( [Subj|Subjects], [[Subj,Subj,Subj,Subj]|Candidates] ) :- candidates( Subjects, Candidates ).</syntaxhighlight> ====layout( ?Layout )==== holds when <var>Layout</var> is the sequence of all (row,column) co-ordinates of defined cells. <syntaxhighlight lang="prolog">layout( Layout ) :- figure( Drawing ), findall( (Row,Column), (position(Cells, Drawing, Row), position(0'X, Cells, Column)), Locations ), sort( Locations, Layout ).</syntaxhighlight> ====position( +Element, +List, ?Position )==== When <var>Element</var> has <var>Position</var> in <var>List</var>. <syntaxhighlight lang="prolog">position( Element, List, Position ) :- position1( List, Element, 1, Position ). position1( [Element|_Rest], Element, N, N ). position1( [_Head|List], Element, N0, N1 ):- N2 is N0 + 1, position1( List, Element, N2, N1 ).</syntaxhighlight> Load a small library of [[Puzzle Utilities]]. <syntaxhighlight lang="prolog">:- ensure_loaded( misc ).</syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/download/nut1.txt here]. === Result === This program reports '''29870''' solutions. d2a8a6192e86007f88ec0243074096d371ed825c 158 157 2016-05-18T23:05:36Z John 2 Simplify the construction of the Cells data structure. wikitext text/x-wiki ;Constrained Permutations in Prolog __NOTOC__ Problem posted to [https://groups.google.com/forum/#!msg/comp.lang.prolog/e_-sEr4tuF4/gEEKXjLqhKkJ comp.lang.prolog] by Daniel Dudley ===Problem Statement=== <blockquote>A university was to hold an examination in 5 subjects: Norwegian, German, English, French and Spanish. In each of these languages there were 4 candidates. The examination room was therefore divided into 20 cells, as shown in the figure below (view this in a fixed font): <syntaxhighlight lang="prolog">figure( [ " X ", " XXXXX", " XXXX ", " XXXX ", "XXXXX ", " X " ] ).</syntaxhighlight> The university's administration wanted to secure themselves against cheating. Candidates in the same language were to be completely isolated from each other - so much so that their cells were not to coincide even at the corners. A young lecturer was given the job of finding a solution to the problem, which he did, and justly received a pat on the back from the dean. Now it just so happens that the dean is an ardent prolog programmer in his spare time (how else could he make dean?) and, realizing that there could be several solutions to the problem, used his skills to find all solutions. Can you do the same? </blockquote> ===Note=== &ldquo;Several solutions&rdquo; doesn't really cover it! Assuming that by &lsquo;a solution&rsquo; we mean finding a mapping between candidates and cells, then, having found one such solution, we can easily find 955,514,879 other members of its solution &ldquo;family&rdquo; through: * ''candidate permutation'': There are (4!)⁵ permutations of the candidates within the cells allocated to their subjects; * ''subject permutation'': we can multiply the candidate permutations by the 5! permutations of the subjects allocated to particular sets of cells. This means that the total number of solutions is 955514880 &times; D where D is the number of solution families i.e. solutions that cannot be derived from each other by candidate or subject permutation. Finding [[#Result|D]] is the more interesting problem solved by this program. ====nut1( ?Solutions )==== <var>Solutions</var> is the number of distinct solutions to the subject/cell allocation problem for any five different subjects. <syntaxhighlight lang="prolog">nut1( Solutions ) :- Norwegian = 1, German = 2, English = 3, French = 4, Spanish = 5, candidates( [Norwegian,German,English,French,Spanish], Candidates ), cells( Cells ), count_solutions( allocate(Cells,Candidates), Solutions ).</syntaxhighlight> ====allocate( +Cells, +Candidates )==== holds when each cell in <var>Cells</var> holds a candidate from <var>Candidates</var>. <syntaxhighlight lang="prolog">allocate( Cells, Candidates ) :- allocation( Cells, 1, Candidates ).</syntaxhighlight> ====allocation( +Cells, +NextSubject, +Subjects )==== holds when <var>Cells</var> is a representation of a distinct solution to the subject/cell allocation problem. <var>NextSubject</var> is the highest subject that can be allocated next, while <var>Subjects</var> is the list of subjects needing allocation to <var>Cells</var>. Each subject is represented by a list, in which each occurrence of the subject number represents a candidate. We guarantee distinct solutions by ensuring that the allocation is made on the following basis: * For each subject: the location of the N+1th candidate must be a successor of the location of the Nth candidate - to eliminate candidate permutations. * The location of the first candidate of the N+1th subject must be a successor of the location of the first candidate of the Nth subject &ndash; to eliminate subject permutations. Operationally, at each step we select a candidate for a cell and constrain each of the cell's adjacent successors to have a different subject from it. <syntaxhighlight lang="prolog">allocation( [], _Next, [] ). allocation( [Cell|Cells], Next, Subjects ) :- allocate_candidate( Subjects, Next, Candidate, Subjects1, Next1 ), cell( Candidate, Cell ), adjacent_successors( Cell, AdjacentSuccessors ), blocked( AdjacentSuccessors, Candidate ), allocation( Cells, Next1, Subjects1 ).</syntaxhighlight> ====allocate_candidate( +Subjects, +Next, ?Candidate, ?Subjects1, ?Next1 )==== holds when <var>Candidate</var> is taken from <var>Subjects</var> leaving <var>Subjects1</var>. <var>Candidate</var> is represented by a subject number &le; <var>Next</var>. <var>Next1</var> is the highest subject that can be allocated to the next cell, ensuring that the first candidate for each subject is allocated in order. <syntaxhighlight lang="prolog">allocate_candidate( [Subject|Subjects], Next, Candidate, Subjects1, Next1 ) :- Subject = [Candidate|Candidates], Candidate =< Next, Next1 is max(Candidate+1,Next), residual_candidates( Candidates, Subjects, Subjects1 ). allocate_candidate( [Subject|Subjects], Next, Candidate, [Subject|Subjects1], Next1 ) :- Subject = [Candidate0|_Candidates], Candidate0 < Next, allocate_candidate( Subjects, Next, Candidate, Subjects1, Next1 ). residual_candidates( [], Subjects, Subjects ). residual_candidates( Candidates, Subjects, [Candidates|Subjects] ) :- Candidates = [_|_].</syntaxhighlight> ====cells( ?Layout )==== holds when <var>Layout</var> is a list of cells ordered by their row &times; column coordinates. Each cell is described by 5 binary digits, which indicate the subject assigned to it, and the set of successors of the cell that are adjacent to it. <syntaxhighlight lang="prolog">cells( Layout ) :- findall( location_cell(Row,Column,_Cell), location(Row, Column), Cells ), sort( Cells, Ordered ), cells1( Ordered, Layout ). cells1( [], [] ). cells1( [location_cell(Row,Column,Cell)|Successors], [Cell|Matrix] ) :- adjacent_successors( Cell, AdjacentSuccessors ), cells2( Successors, Row, Column, AdjacentSuccessors ), cells1( Successors, Matrix ). cells2( [], _Row, _Column, [] ). cells2( [location_cell(Row1,Column1,Cell)|Layout], Row, Column, Adjacent ) :- ( adjacent( Row, Row1 ), adjacent( Column, Column1 ) -> Adjacent = [Cell|Adjacent1] ; otherwise -> Adjacent = Adjacent1 ), cells2( Layout, Row, Column, Adjacent1 ).</syntaxhighlight> ====location( ?Row, ?Column )==== holds when Row and Column are the (unary) row and column offsets of an "X" in <code>figure/1</code>. <syntaxhighlight lang="prolog">location( Row, Column ) :- X is "X", figure( Drawing ), offset( Cells, Drawing, Row ), offset( X, Cells, Column ).</syntaxhighlight> ====cell( ?Subject, ?Cell )==== holds when <var>Cell</var> is the cell representation for <var>Subject</var>. <syntaxhighlight lang="prolog">cell( 1, cell(1,0,0,0,0,_) ). cell( 2, cell(0,1,0,0,0,_) ). cell( 3, cell(0,0,1,0,0,_) ). cell( 4, cell(0,0,0,1,0,_) ). cell( 5, cell(0,0,0,0,1,_) ).</syntaxhighlight> ====block( ?Subject, ?Block )==== holds when <var>Block</var> is a cell representation that is incompatible with <var>Subject</var>. <syntaxhighlight lang="prolog">block( 1, cell(0,_,_,_,_,_) ). block( 2, cell(_,0,_,_,_,_) ). block( 3, cell(_,_,0,_,_,_) ). block( 4, cell(_,_,_,0,_,_) ). block( 5, cell(_,_,_,_,0,_) ).</syntaxhighlight> ====adjacent_successors( ?Cell, ?AdjacentSuccesors )==== holds when <var>AdjacentSuccesors</var> is the set of successors of <var>Cell</var> that are adjacent to it. <syntaxhighlight lang="prolog">adjacent_successors( cell(_,_,_,_,_,AdjacentSuccesors), AdjacentSuccesors ).</syntaxhighlight> ====blocked( +Blocked, ?Subject )==== holds when all the cells in <var>Blocked</var> are incompatible with <var>Subject</var>. <syntaxhighlight lang="prolog">blocked( [], _Subject ). blocked( [Cell|Blocked], Subject ) :- block( Subject, Cell ), blocked( Blocked, Subject ).</syntaxhighlight> ====candidates( ?Subjects, ?Candidates )==== holds when there are 4 <var>Candidates</var> for each subject in <var>Subjects</var>. <syntaxhighlight lang="prolog">candidates( [], [] ). candidates( [Subj|Subjects], [[Subj,Subj,Subj,Subj]|Candidates] ) :- candidates( Subjects, Candidates ).</syntaxhighlight> ====offset( +Element, +List, ?Offset )==== When <var>Element</var> has unary <var>Offset</var> from the head of <var>List</var>. <syntaxhighlight lang="prolog">offset( Element, List, Position ) :- offset1( List, Element, 0, Position ). offset1( [Element|_Rest], Element, N, N ). offset1( [_Head|List], Element, N0, N ):- offset1( List, Element, s(N0), N ).</syntaxhighlight> ====adjacent( +Coordinate0, ?Coordinate1 )==== holds when <var>Coordinate0</var> and <var>Coordinate1</var> are the same or differ by 1. <syntaxhighlight lang="prolog">adjacent( N, N ). adjacent( N, s(N) ). adjacent( s(N), N ).</syntaxhighlight> Load a small library of [[Puzzle Utilities]]. <syntaxhighlight lang="prolog">:- ensure_loaded( misc ).</syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/download/nut1.txt here]. === Result === This program reports '''29870''' solutions. 374e09c46747f7c7b3e4be04dcb5b091de9fd284 159 158 2016-05-18T23:13:11Z John 2 /* location( ?Row, ?Column ) */ fix vars wikitext text/x-wiki ;Constrained Permutations in Prolog __NOTOC__ Problem posted to [https://groups.google.com/forum/#!msg/comp.lang.prolog/e_-sEr4tuF4/gEEKXjLqhKkJ comp.lang.prolog] by Daniel Dudley ===Problem Statement=== <blockquote>A university was to hold an examination in 5 subjects: Norwegian, German, English, French and Spanish. In each of these languages there were 4 candidates. The examination room was therefore divided into 20 cells, as shown in the figure below (view this in a fixed font): <syntaxhighlight lang="prolog">figure( [ " X ", " XXXXX", " XXXX ", " XXXX ", "XXXXX ", " X " ] ).</syntaxhighlight> The university's administration wanted to secure themselves against cheating. Candidates in the same language were to be completely isolated from each other - so much so that their cells were not to coincide even at the corners. A young lecturer was given the job of finding a solution to the problem, which he did, and justly received a pat on the back from the dean. Now it just so happens that the dean is an ardent prolog programmer in his spare time (how else could he make dean?) and, realizing that there could be several solutions to the problem, used his skills to find all solutions. Can you do the same? </blockquote> ===Note=== &ldquo;Several solutions&rdquo; doesn't really cover it! Assuming that by &lsquo;a solution&rsquo; we mean finding a mapping between candidates and cells, then, having found one such solution, we can easily find 955,514,879 other members of its solution &ldquo;family&rdquo; through: * ''candidate permutation'': There are (4!)⁵ permutations of the candidates within the cells allocated to their subjects; * ''subject permutation'': we can multiply the candidate permutations by the 5! permutations of the subjects allocated to particular sets of cells. This means that the total number of solutions is 955514880 &times; D where D is the number of solution families i.e. solutions that cannot be derived from each other by candidate or subject permutation. Finding [[#Result|D]] is the more interesting problem solved by this program. ====nut1( ?Solutions )==== <var>Solutions</var> is the number of distinct solutions to the subject/cell allocation problem for any five different subjects. <syntaxhighlight lang="prolog">nut1( Solutions ) :- Norwegian = 1, German = 2, English = 3, French = 4, Spanish = 5, candidates( [Norwegian,German,English,French,Spanish], Candidates ), cells( Cells ), count_solutions( allocate(Cells,Candidates), Solutions ).</syntaxhighlight> ====allocate( +Cells, +Candidates )==== holds when each cell in <var>Cells</var> holds a candidate from <var>Candidates</var>. <syntaxhighlight lang="prolog">allocate( Cells, Candidates ) :- allocation( Cells, 1, Candidates ).</syntaxhighlight> ====allocation( +Cells, +NextSubject, +Subjects )==== holds when <var>Cells</var> is a representation of a distinct solution to the subject/cell allocation problem. <var>NextSubject</var> is the highest subject that can be allocated next, while <var>Subjects</var> is the list of subjects needing allocation to <var>Cells</var>. Each subject is represented by a list, in which each occurrence of the subject number represents a candidate. We guarantee distinct solutions by ensuring that the allocation is made on the following basis: * For each subject: the location of the N+1th candidate must be a successor of the location of the Nth candidate - to eliminate candidate permutations. * The location of the first candidate of the N+1th subject must be a successor of the location of the first candidate of the Nth subject &ndash; to eliminate subject permutations. Operationally, at each step we select a candidate for a cell and constrain each of the cell's adjacent successors to have a different subject from it. <syntaxhighlight lang="prolog">allocation( [], _Next, [] ). allocation( [Cell|Cells], Next, Subjects ) :- allocate_candidate( Subjects, Next, Candidate, Subjects1, Next1 ), cell( Candidate, Cell ), adjacent_successors( Cell, AdjacentSuccessors ), blocked( AdjacentSuccessors, Candidate ), allocation( Cells, Next1, Subjects1 ).</syntaxhighlight> ====allocate_candidate( +Subjects, +Next, ?Candidate, ?Subjects1, ?Next1 )==== holds when <var>Candidate</var> is taken from <var>Subjects</var> leaving <var>Subjects1</var>. <var>Candidate</var> is represented by a subject number &le; <var>Next</var>. <var>Next1</var> is the highest subject that can be allocated to the next cell, ensuring that the first candidate for each subject is allocated in order. <syntaxhighlight lang="prolog">allocate_candidate( [Subject|Subjects], Next, Candidate, Subjects1, Next1 ) :- Subject = [Candidate|Candidates], Candidate =< Next, Next1 is max(Candidate+1,Next), residual_candidates( Candidates, Subjects, Subjects1 ). allocate_candidate( [Subject|Subjects], Next, Candidate, [Subject|Subjects1], Next1 ) :- Subject = [Candidate0|_Candidates], Candidate0 < Next, allocate_candidate( Subjects, Next, Candidate, Subjects1, Next1 ). residual_candidates( [], Subjects, Subjects ). residual_candidates( Candidates, Subjects, [Candidates|Subjects] ) :- Candidates = [_|_].</syntaxhighlight> ====cells( ?Layout )==== holds when <var>Layout</var> is a list of cells ordered by their row &times; column coordinates. Each cell is described by 5 binary digits, which indicate the subject assigned to it, and the set of successors of the cell that are adjacent to it. <syntaxhighlight lang="prolog">cells( Layout ) :- findall( location_cell(Row,Column,_Cell), location(Row, Column), Cells ), sort( Cells, Ordered ), cells1( Ordered, Layout ). cells1( [], [] ). cells1( [location_cell(Row,Column,Cell)|Successors], [Cell|Matrix] ) :- adjacent_successors( Cell, AdjacentSuccessors ), cells2( Successors, Row, Column, AdjacentSuccessors ), cells1( Successors, Matrix ). cells2( [], _Row, _Column, [] ). cells2( [location_cell(Row1,Column1,Cell)|Layout], Row, Column, Adjacent ) :- ( adjacent( Row, Row1 ), adjacent( Column, Column1 ) -> Adjacent = [Cell|Adjacent1] ; otherwise -> Adjacent = Adjacent1 ), cells2( Layout, Row, Column, Adjacent1 ).</syntaxhighlight> ====location( ?Row, ?Column )==== holds when <var>Row</var> and <var>Column</var> are the (unary) row and column offsets of an "X" in <code>figure/1</code>. <syntaxhighlight lang="prolog">location( Row, Column ) :- X is "X", figure( Drawing ), offset( Cells, Drawing, Row ), offset( X, Cells, Column ).</syntaxhighlight> ====cell( ?Subject, ?Cell )==== holds when <var>Cell</var> is the cell representation for <var>Subject</var>. <syntaxhighlight lang="prolog">cell( 1, cell(1,0,0,0,0,_) ). cell( 2, cell(0,1,0,0,0,_) ). cell( 3, cell(0,0,1,0,0,_) ). cell( 4, cell(0,0,0,1,0,_) ). cell( 5, cell(0,0,0,0,1,_) ).</syntaxhighlight> ====block( ?Subject, ?Block )==== holds when <var>Block</var> is a cell representation that is incompatible with <var>Subject</var>. <syntaxhighlight lang="prolog">block( 1, cell(0,_,_,_,_,_) ). block( 2, cell(_,0,_,_,_,_) ). block( 3, cell(_,_,0,_,_,_) ). block( 4, cell(_,_,_,0,_,_) ). block( 5, cell(_,_,_,_,0,_) ).</syntaxhighlight> ====adjacent_successors( ?Cell, ?AdjacentSuccesors )==== holds when <var>AdjacentSuccesors</var> is the set of successors of <var>Cell</var> that are adjacent to it. <syntaxhighlight lang="prolog">adjacent_successors( cell(_,_,_,_,_,AdjacentSuccesors), AdjacentSuccesors ).</syntaxhighlight> ====blocked( +Blocked, ?Subject )==== holds when all the cells in <var>Blocked</var> are incompatible with <var>Subject</var>. <syntaxhighlight lang="prolog">blocked( [], _Subject ). blocked( [Cell|Blocked], Subject ) :- block( Subject, Cell ), blocked( Blocked, Subject ).</syntaxhighlight> ====candidates( ?Subjects, ?Candidates )==== holds when there are 4 <var>Candidates</var> for each subject in <var>Subjects</var>. <syntaxhighlight lang="prolog">candidates( [], [] ). candidates( [Subj|Subjects], [[Subj,Subj,Subj,Subj]|Candidates] ) :- candidates( Subjects, Candidates ).</syntaxhighlight> ====offset( +Element, +List, ?Offset )==== When <var>Element</var> has unary <var>Offset</var> from the head of <var>List</var>. <syntaxhighlight lang="prolog">offset( Element, List, Position ) :- offset1( List, Element, 0, Position ). offset1( [Element|_Rest], Element, N, N ). offset1( [_Head|List], Element, N0, N ):- offset1( List, Element, s(N0), N ).</syntaxhighlight> ====adjacent( +Coordinate0, ?Coordinate1 )==== holds when <var>Coordinate0</var> and <var>Coordinate1</var> are the same or differ by 1. <syntaxhighlight lang="prolog">adjacent( N, N ). adjacent( N, s(N) ). adjacent( s(N), N ).</syntaxhighlight> Load a small library of [[Puzzle Utilities]]. <syntaxhighlight lang="prolog">:- ensure_loaded( misc ).</syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/download/nut1.txt here]. === Result === This program reports '''29870''' solutions. bf259371b81d9c819cef38fa6292974916609f42 172 159 2017-01-05T20:59:01Z John 2 Remove broken syntax highlighting wikitext text/x-wiki ;Constrained Permutations in Prolog __NOTOC__ Problem posted to [https://groups.google.com/forum/#!msg/comp.lang.prolog/e_-sEr4tuF4/gEEKXjLqhKkJ comp.lang.prolog] by Daniel Dudley ===Problem Statement=== <blockquote>A university was to hold an examination in 5 subjects: Norwegian, German, English, French and Spanish. In each of these languages there were 4 candidates. The examination room was therefore divided into 20 cells, as shown in the figure below (view this in a fixed font): <pre class="prolog">figure( [ " X ", " XXXXX", " XXXX ", " XXXX ", "XXXXX ", " X " ] ).</pre> The university's administration wanted to secure themselves against cheating. Candidates in the same language were to be completely isolated from each other - so much so that their cells were not to coincide even at the corners. A young lecturer was given the job of finding a solution to the problem, which he did, and justly received a pat on the back from the dean. Now it just so happens that the dean is an ardent prolog programmer in his spare time (how else could he make dean?) and, realizing that there could be several solutions to the problem, used his skills to find all solutions. Can you do the same? </blockquote> ===Note=== &ldquo;Several solutions&rdquo; doesn't really cover it! Assuming that by &lsquo;a solution&rsquo; we mean finding a mapping between candidates and cells, then, having found one such solution, we can easily find 955,514,879 other members of its solution &ldquo;family&rdquo; through: * ''candidate permutation'': There are (4!)⁵ permutations of the candidates within the cells allocated to their subjects; * ''subject permutation'': we can multiply the candidate permutations by the 5! permutations of the subjects allocated to particular sets of cells. This means that the total number of solutions is 955514880 &times; D where D is the number of solution families i.e. solutions that cannot be derived from each other by candidate or subject permutation. Finding [[#Result|D]] is the more interesting problem solved by this program. ====nut1( ?Solutions )==== <var>Solutions</var> is the number of distinct solutions to the subject/cell allocation problem for any five different subjects. <pre class="prolog">nut1( Solutions ) :- Norwegian = 1, German = 2, English = 3, French = 4, Spanish = 5, candidates( [Norwegian,German,English,French,Spanish], Candidates ), cells( Cells ), count_solutions( allocate(Cells,Candidates), Solutions ).</pre> ====allocate( +Cells, +Candidates )==== holds when each cell in <var>Cells</var> holds a candidate from <var>Candidates</var>. <pre class="prolog">allocate( Cells, Candidates ) :- allocation( Cells, 1, Candidates ).</pre> ====allocation( +Cells, +NextSubject, +Subjects )==== holds when <var>Cells</var> is a representation of a distinct solution to the subject/cell allocation problem. <var>NextSubject</var> is the highest subject that can be allocated next, while <var>Subjects</var> is the list of subjects needing allocation to <var>Cells</var>. Each subject is represented by a list, in which each occurrence of the subject number represents a candidate. We guarantee distinct solutions by ensuring that the allocation is made on the following basis: * For each subject: the location of the N+1th candidate must be a successor of the location of the Nth candidate - to eliminate candidate permutations. * The location of the first candidate of the N+1th subject must be a successor of the location of the first candidate of the Nth subject &ndash; to eliminate subject permutations. Operationally, at each step we select a candidate for a cell and constrain each of the cell's adjacent successors to have a different subject from it. <pre class="prolog">allocation( [], _Next, [] ). allocation( [Cell|Cells], Next, Subjects ) :- allocate_candidate( Subjects, Next, Candidate, Subjects1, Next1 ), cell( Candidate, Cell ), adjacent_successors( Cell, AdjacentSuccessors ), blocked( AdjacentSuccessors, Candidate ), allocation( Cells, Next1, Subjects1 ).</pre> ====allocate_candidate( +Subjects, +Next, ?Candidate, ?Subjects1, ?Next1 )==== holds when <var>Candidate</var> is taken from <var>Subjects</var> leaving <var>Subjects1</var>. <var>Candidate</var> is represented by a subject number &le; <var>Next</var>. <var>Next1</var> is the highest subject that can be allocated to the next cell, ensuring that the first candidate for each subject is allocated in order. <pre class="prolog">allocate_candidate( [Subject|Subjects], Next, Candidate, Subjects1, Next1 ) :- Subject = [Candidate|Candidates], Candidate =< Next, Next1 is max(Candidate+1,Next), residual_candidates( Candidates, Subjects, Subjects1 ). allocate_candidate( [Subject|Subjects], Next, Candidate, [Subject|Subjects1], Next1 ) :- Subject = [Candidate0|_Candidates], Candidate0 < Next, allocate_candidate( Subjects, Next, Candidate, Subjects1, Next1 ). residual_candidates( [], Subjects, Subjects ). residual_candidates( Candidates, Subjects, [Candidates|Subjects] ) :- Candidates = [_|_].</pre> ====cells( ?Layout )==== holds when <var>Layout</var> is a list of cells ordered by their row &times; column coordinates. Each cell is described by 5 binary digits, which indicate the subject assigned to it, and the set of successors of the cell that are adjacent to it. <pre class="prolog">cells( Layout ) :- findall( location_cell(Row,Column,_Cell), location(Row, Column), Cells ), sort( Cells, Ordered ), cells1( Ordered, Layout ). cells1( [], [] ). cells1( [location_cell(Row,Column,Cell)|Successors], [Cell|Matrix] ) :- adjacent_successors( Cell, AdjacentSuccessors ), cells2( Successors, Row, Column, AdjacentSuccessors ), cells1( Successors, Matrix ). cells2( [], _Row, _Column, [] ). cells2( [location_cell(Row1,Column1,Cell)|Layout], Row, Column, Adjacent ) :- ( adjacent( Row, Row1 ), adjacent( Column, Column1 ) -> Adjacent = [Cell|Adjacent1] ; otherwise -> Adjacent = Adjacent1 ), cells2( Layout, Row, Column, Adjacent1 ).</pre> ====location( ?Row, ?Column )==== holds when <var>Row</var> and <var>Column</var> are the (unary) row and column offsets of an "X" in <code>figure/1</code>. <pre class="prolog">location( Row, Column ) :- X is "X", figure( Drawing ), offset( Cells, Drawing, Row ), offset( X, Cells, Column ).</pre> ====cell( ?Subject, ?Cell )==== holds when <var>Cell</var> is the cell representation for <var>Subject</var>. <pre class="prolog">cell( 1, cell(1,0,0,0,0,_) ). cell( 2, cell(0,1,0,0,0,_) ). cell( 3, cell(0,0,1,0,0,_) ). cell( 4, cell(0,0,0,1,0,_) ). cell( 5, cell(0,0,0,0,1,_) ).</pre> ====block( ?Subject, ?Block )==== holds when <var>Block</var> is a cell representation that is incompatible with <var>Subject</var>. <pre class="prolog">block( 1, cell(0,_,_,_,_,_) ). block( 2, cell(_,0,_,_,_,_) ). block( 3, cell(_,_,0,_,_,_) ). block( 4, cell(_,_,_,0,_,_) ). block( 5, cell(_,_,_,_,0,_) ).</pre> ====adjacent_successors( ?Cell, ?AdjacentSuccesors )==== holds when <var>AdjacentSuccesors</var> is the set of successors of <var>Cell</var> that are adjacent to it. <pre class="prolog">adjacent_successors( cell(_,_,_,_,_,AdjacentSuccesors), AdjacentSuccesors ).</pre> ====blocked( +Blocked, ?Subject )==== holds when all the cells in <var>Blocked</var> are incompatible with <var>Subject</var>. <pre class="prolog">blocked( [], _Subject ). blocked( [Cell|Blocked], Subject ) :- block( Subject, Cell ), blocked( Blocked, Subject ).</pre> ====candidates( ?Subjects, ?Candidates )==== holds when there are 4 <var>Candidates</var> for each subject in <var>Subjects</var>. <pre class="prolog">candidates( [], [] ). candidates( [Subj|Subjects], [[Subj,Subj,Subj,Subj]|Candidates] ) :- candidates( Subjects, Candidates ).</pre> ====offset( +Element, +List, ?Offset )==== When <var>Element</var> has unary <var>Offset</var> from the head of <var>List</var>. <pre class="prolog">offset( Element, List, Position ) :- offset1( List, Element, 0, Position ). offset1( [Element|_Rest], Element, N, N ). offset1( [_Head|List], Element, N0, N ):- offset1( List, Element, s(N0), N ).</pre> ====adjacent( +Coordinate0, ?Coordinate1 )==== holds when <var>Coordinate0</var> and <var>Coordinate1</var> are the same or differ by 1. <pre class="prolog">adjacent( N, N ). adjacent( N, s(N) ). adjacent( s(N), N ).</pre> Load a small library of [[Puzzle Utilities]]. <pre class="prolog">:- ensure_loaded( misc ).</pre> The code is available as plain text [https://binding-time.co.uk/download/nut1.txt here]. === Result === This program reports '''29870''' solutions. 843020dd131841971216a9c30af5f0847defc762 0 16 160 121 2016-05-22T00:25:30Z John 2 Updated O'Keefe link wikitext text/x-wiki __NOTOC__ <blockquote> &ldquo;I have a hard time arguing that anything in XML is generically useful any more except for the basic syntax, which lets us apply some very handy low-level tools like parsers and XSLT. The rest (XLink, schemas, etc.) has been a pointless trip into complexity.&rdquo; <cite>[http://lists.w3.org/Archives/Public/www-tag/2002Sep/0303.html Simon St.Laurent]</cite> </blockquote> <blockquote> &ldquo;My own experience is that having Prolog, Scheme, and Haskell available it'll take a gun pointed at my head or an extremely large bribe to make me use XSLT for anything.&rdquo; <cite>[http://cliplab.org/Mail/ciao-users/2001/000207.html Richard A. O'Keefe]</cite> </blockquote> ==Background== xml.pl is a module for parsing XML with Prolog, which provides Prolog applications with a simple 'Document Value Model' interface to XML documents. It has been used successfully in a number of applications. It supports a subset of XML suitable for XML Data and Worldwide Web applications but it is neither as strict nor as comprehensive as the [http://www.w3.org/TR/2000/REC-xml-20001006 XML 1.0 Specification] mandates. * It is not as strict because, while the specification must eliminate ambiguities, not all errors need to be regarded as faults, and some reasonable examples of real XML usage would have to be rejected if they were. * It is not as comprehensive because, where the XML specification makes provision for more or less complete DTDs to be provided as part of a document, xml.pl actions the local definition of ENTITIES only. Other DTD extensions are treated as commentary. ===Download the [[XML Module]] (xml.pl and plxml)=== xml.pl and plxml, a small Windows application which embodies xml.pl, have been placed into the public domain to encourage the use of Prolog with XML. I hope that they will be useful to you, but they are not supported, and they are provided without any warranty of any kind. ==Specification== Three predicates are exported by the module: <code>xml_parse/[2,3]</code>, <code>xml_subterm/2</code> and <code>xml_pp/1</code> . ====xml_parse( {+Controls,} +?Chars, ?+Document )==== parses <var>Chars</var>, a list of character codes, to/from <var>Document</var>, a data structure of the form <code>xml(Attributes, Content)</code>, where: ''Attributes'' is a list of ''Name''=''CharData'' attributes from the (possibly implicit) XML signature of the document. ''Content'' is a (possibly empty) list comprising occurrences of: ; <code>pcdata(CharData)</code> : Text ; <code>comment(CharData)</code> : An XML comment; ; <code>namespace(URI, Prefix, Element)</code> : a Namespace ; <code>element(Tag, Attributes, Content)</code> : <Tag>..</Tag> encloses Content or <Tag/> if Content is empty <nowiki>[]</nowiki>. ; <code>instructions(Name, CharData)</code> : A PI <?Name CharData?> ; <code>cdata(CharData)</code> : <![CDATA[CharData]]> ; <code>doctype(Tag, DoctypeId)</code> : DTD <!DOCTYPE .. > The conversions are not completely symmetrical in that weaker XML is accepted than can be generated. Specifically, in-bound ''(Chars -> Document)'' parsing does not require strictly well-formed XML. If <var>Chars</var> does not represent well-formed XML, <var>Document</var> is instantiated to the term <code>malformed(Attributes, Content)</code>. The ''Content'' of a ''malformed/2'' structure can include: ; <code>unparsed( CharData )</code> : Text which has not been parsed ; <code>out_of_context(Tag)</code> : <Tag> is not closed in addition to the parsed-term types. Out-bound ''(<var>Document</var> -> <var>Chars</var>)'' parsing ''does'' require that <var>Document</var> defines well-formed XML. If an error is detected, a 'domain' exception is raised. The domain exception will attempt to identify the particular sub-term in error, and will list the ancestor elements of the sub-term in error as <code>Tag{(Id)}</code> terms - where ''Id'' is the value of any attribute named id. The <var>Controls</var> applying to in-bound ''(<var>Chars</var> -> <var>Document</var>)'' parsing are: ; <code>extended_characters(Boolean)</code> : Use the extended character entities for XHTML (default true). ; <code>format(Boolean)</code> : Remove layouts when no non-layout character data appears between elements (default true). ; <code>remove_attribute_prefixes(Boolean)</code> : Remove redundant prefixes from attributes - i.e. prefixes denoting the namespace of the parent element (default false). ; <code> allow_ampersand(Boolean) </code> : Allow unescaped ampersand characters (&) to occur in PCDATA (default false). For out-bound ''(<var>Document</var> -> <var>Chars</var>)'' parsing, the only available option is: ; <code>format(Boolean)</code> : Indent the element content, (default true) ===Types=== ; Tag : An atom naming an element ; Name : An atom, not naming an element ; URI : An atom giving the URI of a Namespace ; CharData : A "string": list of character codes. ; DoctypeId : one of: <code>public(CharData,&nbsp;CharData&nbsp;{,&nbsp;DTDLiterals})</code>, <code>system(CharData&nbsp;{,&nbsp;DTDLiterals})</code> or <code>local{(DTDLiterals)}</code> ; DTDLiterals : A non-empty list of <code>dtd_literal(CharData)</code> terms - e.g. [http://www.w3.org/TR/2000/REC-xml-20001006#NT-AttlistDecl attribute-list declarations]. ; Boolean : one of <code>true</code> or <code>false</code> ====xml_subterm( +XMLTerm, ?Subterm )==== unifies <var>Subterm</var> with a sub-term of <var>XMLTerm</var>. This can be especially useful when trying to test or retrieve a deeply-nested subterm from a document, as demonstrated in the [[XML Query Use Cases with xml.pl]] examples. Note that <var>XMLTerm</var> is a sub-term of itself. ====xml_pp( +XMLDocument )==== "pretty prints" <var>XMLDocument</var> on the current output stream. ==Availability== On this site, you can download the [[XML Module]]. The module is also supplied as a library with the following Prologs: * It has been adapted for the [http://logtalk.org/ Logtalk Open source object-oriented extension to Prolog] by Paulo Moura. (See the folder "contributions/xml_parser" from release 2.29.1); * It is available in the [http://eclipseclp.org/ ECLiPSe Constraint Programming System], as a third-party library; * It has been ported to [http://www.picat-lang.org/bprolog/ B-Prolog] by Neng-Fa Zhou. * It has been adapted for [http://sicstus.sics.se/thirdparty.html SICStus Prolog] by Mats Carlsson. * It is included in [http://quintus.sics.se/ Quintus Prolog Release 3.5]. [[XML Query Use Cases with xml.pl]] is provided as an example to illustrate the way that the code can be used. ==Features of xml.pl== The <code>xml/2</code> data structure has some useful properties. ===Reusability=== Using a native Prolog representation of XML, in which terms represent document 'nodes', makes the parser reusable for any XML application. In effect, xml.pl encapsulates the application-independent tasks of document parsing and generation, which is essential where documents have components from more than one Namespace. ===Same Structure=== The Prolog term representing a document has the same structure as the document itself, which makes the correspondence between the literal representation of the Prolog term and the XML source readily apparent. For example, this simple [http://www.w3.org/Graphics/SVG/ SVG] image: <syntaxhighlight lang="xml"> <?xml version="1.0" standalone="no"?> <!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.0//EN" "http://www.w3.org/.../svg10.dtd" [ <!ENTITY redblue "fill: red; stroke: blue; stroke-width: 1"> ]> <svg xmlns="http://www.w3.org/2000/svg" width="500" height="500"> <circle cx=" 25 " cy=" 25 " r=" 24 " style="&redblue;"/> </svg> </syntaxhighlight> ... translates into this Prolog term: <syntaxhighlight lang="prolog"> xml( [version="1.0", standalone="no"], [ doctype( svg, public( "-//W3C//DTD SVG 1.0//EN", "http://www.w3.org/.../svg10.dtd" ) ), namespace( 'http://www.w3.org/2000/svg', "", element( svg, [width="500", height="500"], [ element( circle, [cx="25", cy="25", r="24", style="fill: red; stroke: blue; stroke-width: 1"], [] ) ] ) ) ] ). </syntaxhighlight> ===Efficient Manipulation=== Each type of node in an XML document is represented by a different Prolog functor, while data, (PCDATA, CDATA and Attribute Values), are left as "strings", (lists of character codes). The use of distinct functors for mark-up structures enables the efficient recursive traversal of a document, while leaving the data as strings facilitates the application-specific parsing of data content (aka [http://www.google.com/search?q=%22Micro-parsing%22+XML Micro-parsing]). For example, to turn every CDATA node into a PCDATA node with tabs expanded into spaces: <syntaxhighlight lang="prolog"> cdata_to_pcdata( cdata(CharsWithTabs), pcdata(CharsWithSpaces) ) :- tab_expansion( CharsWithTabs, CharsWithSpaces ). cdata_to_pcdata( xml(Attributes, Content1), xml(Attributes, Content2) ) :- cdata_to_pcdata( Content1, Content2 ). cdata_to_pcdata( namespace(URI,Pfx,Content1), namespace(URI,Pfx,Content2) ) :- cdata_to_pcdata( Content1, Content2 ). cdata_to_pcdata( element(Name,Atts,Content1), element(Name,Atts,Content2) ) :- cdata_to_pcdata( Content1, Content2 ). cdata_to_pcdata( [], [] ). cdata_to_pcdata( [H1|T1], [H2|T2] ) :- cdata_to_pcdata( H1, H2 ), cdata_to_pcdata( T1, T2 ). cdata_to_pcdata( pcdata(Chars), pcdata(Chars) ). cdata_to_pcdata( comment(Chars), comment(Chars) ). cdata_to_pcdata( instructions(Name, Chars), instructions(Name, Chars) ). cdata_to_pcdata( doctype(Tag, DoctypeId), doctype(Tag, DoctypeId) ). </syntaxhighlight> The above uses no 'cuts', but will not create any choice points with ground input. ===Elegance=== The resolution of entity references and the decomposition of the document into distinct nodes means that the calling application is not concerned with the occasionally messy syntax of XML documents. For example, the clean separation of namespace nodes means that Namespaces, which are useful in combining specifications developed separately, have similar usefulness in combining applications developed separately. 4f5998dd63412eadbe54721a476b04bdc91ae29b 168 160 2017-01-03T22:34:25Z John 2 /* Availability */ wikitext text/x-wiki __NOTOC__ <blockquote> &ldquo;I have a hard time arguing that anything in XML is generically useful any more except for the basic syntax, which lets us apply some very handy low-level tools like parsers and XSLT. The rest (XLink, schemas, etc.) has been a pointless trip into complexity.&rdquo; <cite>[http://lists.w3.org/Archives/Public/www-tag/2002Sep/0303.html Simon St.Laurent]</cite> </blockquote> <blockquote> &ldquo;My own experience is that having Prolog, Scheme, and Haskell available it'll take a gun pointed at my head or an extremely large bribe to make me use XSLT for anything.&rdquo; <cite>[http://cliplab.org/Mail/ciao-users/2001/000207.html Richard A. O'Keefe]</cite> </blockquote> ==Background== xml.pl is a module for parsing XML with Prolog, which provides Prolog applications with a simple 'Document Value Model' interface to XML documents. It has been used successfully in a number of applications. It supports a subset of XML suitable for XML Data and Worldwide Web applications but it is neither as strict nor as comprehensive as the [http://www.w3.org/TR/2000/REC-xml-20001006 XML 1.0 Specification] mandates. * It is not as strict because, while the specification must eliminate ambiguities, not all errors need to be regarded as faults, and some reasonable examples of real XML usage would have to be rejected if they were. * It is not as comprehensive because, where the XML specification makes provision for more or less complete DTDs to be provided as part of a document, xml.pl actions the local definition of ENTITIES only. Other DTD extensions are treated as commentary. ===Download the [[XML Module]] (xml.pl and plxml)=== xml.pl and plxml, a small Windows application which embodies xml.pl, have been placed into the public domain to encourage the use of Prolog with XML. I hope that they will be useful to you, but they are not supported, and they are provided without any warranty of any kind. ==Specification== Three predicates are exported by the module: <code>xml_parse/[2,3]</code>, <code>xml_subterm/2</code> and <code>xml_pp/1</code> . ====xml_parse( {+Controls,} +?Chars, ?+Document )==== parses <var>Chars</var>, a list of character codes, to/from <var>Document</var>, a data structure of the form <code>xml(Attributes, Content)</code>, where: ''Attributes'' is a list of ''Name''=''CharData'' attributes from the (possibly implicit) XML signature of the document. ''Content'' is a (possibly empty) list comprising occurrences of: ; <code>pcdata(CharData)</code> : Text ; <code>comment(CharData)</code> : An XML comment; ; <code>namespace(URI, Prefix, Element)</code> : a Namespace ; <code>element(Tag, Attributes, Content)</code> : <Tag>..</Tag> encloses Content or <Tag/> if Content is empty <nowiki>[]</nowiki>. ; <code>instructions(Name, CharData)</code> : A PI <?Name CharData?> ; <code>cdata(CharData)</code> : <![CDATA[CharData]]> ; <code>doctype(Tag, DoctypeId)</code> : DTD <!DOCTYPE .. > The conversions are not completely symmetrical in that weaker XML is accepted than can be generated. Specifically, in-bound ''(Chars -> Document)'' parsing does not require strictly well-formed XML. If <var>Chars</var> does not represent well-formed XML, <var>Document</var> is instantiated to the term <code>malformed(Attributes, Content)</code>. The ''Content'' of a ''malformed/2'' structure can include: ; <code>unparsed( CharData )</code> : Text which has not been parsed ; <code>out_of_context(Tag)</code> : <Tag> is not closed in addition to the parsed-term types. Out-bound ''(<var>Document</var> -> <var>Chars</var>)'' parsing ''does'' require that <var>Document</var> defines well-formed XML. If an error is detected, a 'domain' exception is raised. The domain exception will attempt to identify the particular sub-term in error, and will list the ancestor elements of the sub-term in error as <code>Tag{(Id)}</code> terms - where ''Id'' is the value of any attribute named id. The <var>Controls</var> applying to in-bound ''(<var>Chars</var> -> <var>Document</var>)'' parsing are: ; <code>extended_characters(Boolean)</code> : Use the extended character entities for XHTML (default true). ; <code>format(Boolean)</code> : Remove layouts when no non-layout character data appears between elements (default true). ; <code>remove_attribute_prefixes(Boolean)</code> : Remove redundant prefixes from attributes - i.e. prefixes denoting the namespace of the parent element (default false). ; <code> allow_ampersand(Boolean) </code> : Allow unescaped ampersand characters (&) to occur in PCDATA (default false). For out-bound ''(<var>Document</var> -> <var>Chars</var>)'' parsing, the only available option is: ; <code>format(Boolean)</code> : Indent the element content, (default true) ===Types=== ; Tag : An atom naming an element ; Name : An atom, not naming an element ; URI : An atom giving the URI of a Namespace ; CharData : A "string": list of character codes. ; DoctypeId : one of: <code>public(CharData,&nbsp;CharData&nbsp;{,&nbsp;DTDLiterals})</code>, <code>system(CharData&nbsp;{,&nbsp;DTDLiterals})</code> or <code>local{(DTDLiterals)}</code> ; DTDLiterals : A non-empty list of <code>dtd_literal(CharData)</code> terms - e.g. [http://www.w3.org/TR/2000/REC-xml-20001006#NT-AttlistDecl attribute-list declarations]. ; Boolean : one of <code>true</code> or <code>false</code> ====xml_subterm( +XMLTerm, ?Subterm )==== unifies <var>Subterm</var> with a sub-term of <var>XMLTerm</var>. This can be especially useful when trying to test or retrieve a deeply-nested subterm from a document, as demonstrated in the [[XML Query Use Cases with xml.pl]] examples. Note that <var>XMLTerm</var> is a sub-term of itself. ====xml_pp( +XMLDocument )==== "pretty prints" <var>XMLDocument</var> on the current output stream. ==Availability== On this site, you can download the [[XML Module]]. The module is also supplied as a library with the following Prologs: * It has been adapted for the [http://logtalk.org/ Logtalk Open source object-oriented extension to Prolog] by Paulo Moura. (See the folder "contributions/xml_parser" from release 2.29.1); * It is available in the [http://eclipseclp.org/ ECLiPSe Constraint Programming System], as a third-party library; * It has been ported to [http://www.picat-lang.org/bprolog/ B-Prolog] by Neng-Fa Zhou. * It has been adapted for [https://sicstus.sics.se/thirdparty.html SICStus Prolog] by Mats Carlsson. * It is included in [https://quintus.sics.se/ Quintus Prolog Release 3.5]. [[XML Query Use Cases with xml.pl]] is provided as an example to illustrate the way that the code can be used. ==Features of xml.pl== The <code>xml/2</code> data structure has some useful properties. ===Reusability=== Using a native Prolog representation of XML, in which terms represent document 'nodes', makes the parser reusable for any XML application. In effect, xml.pl encapsulates the application-independent tasks of document parsing and generation, which is essential where documents have components from more than one Namespace. ===Same Structure=== The Prolog term representing a document has the same structure as the document itself, which makes the correspondence between the literal representation of the Prolog term and the XML source readily apparent. For example, this simple [http://www.w3.org/Graphics/SVG/ SVG] image: <syntaxhighlight lang="xml"> <?xml version="1.0" standalone="no"?> <!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.0//EN" "http://www.w3.org/.../svg10.dtd" [ <!ENTITY redblue "fill: red; stroke: blue; stroke-width: 1"> ]> <svg xmlns="http://www.w3.org/2000/svg" width="500" height="500"> <circle cx=" 25 " cy=" 25 " r=" 24 " style="&redblue;"/> </svg> </syntaxhighlight> ... translates into this Prolog term: <syntaxhighlight lang="prolog"> xml( [version="1.0", standalone="no"], [ doctype( svg, public( "-//W3C//DTD SVG 1.0//EN", "http://www.w3.org/.../svg10.dtd" ) ), namespace( 'http://www.w3.org/2000/svg', "", element( svg, [width="500", height="500"], [ element( circle, [cx="25", cy="25", r="24", style="fill: red; stroke: blue; stroke-width: 1"], [] ) ] ) ) ] ). </syntaxhighlight> ===Efficient Manipulation=== Each type of node in an XML document is represented by a different Prolog functor, while data, (PCDATA, CDATA and Attribute Values), are left as "strings", (lists of character codes). The use of distinct functors for mark-up structures enables the efficient recursive traversal of a document, while leaving the data as strings facilitates the application-specific parsing of data content (aka [http://www.google.com/search?q=%22Micro-parsing%22+XML Micro-parsing]). For example, to turn every CDATA node into a PCDATA node with tabs expanded into spaces: <syntaxhighlight lang="prolog"> cdata_to_pcdata( cdata(CharsWithTabs), pcdata(CharsWithSpaces) ) :- tab_expansion( CharsWithTabs, CharsWithSpaces ). cdata_to_pcdata( xml(Attributes, Content1), xml(Attributes, Content2) ) :- cdata_to_pcdata( Content1, Content2 ). cdata_to_pcdata( namespace(URI,Pfx,Content1), namespace(URI,Pfx,Content2) ) :- cdata_to_pcdata( Content1, Content2 ). cdata_to_pcdata( element(Name,Atts,Content1), element(Name,Atts,Content2) ) :- cdata_to_pcdata( Content1, Content2 ). cdata_to_pcdata( [], [] ). cdata_to_pcdata( [H1|T1], [H2|T2] ) :- cdata_to_pcdata( H1, H2 ), cdata_to_pcdata( T1, T2 ). cdata_to_pcdata( pcdata(Chars), pcdata(Chars) ). cdata_to_pcdata( comment(Chars), comment(Chars) ). cdata_to_pcdata( instructions(Name, Chars), instructions(Name, Chars) ). cdata_to_pcdata( doctype(Tag, DoctypeId), doctype(Tag, DoctypeId) ). </syntaxhighlight> The above uses no 'cuts', but will not create any choice points with ground input. ===Elegance=== The resolution of entity references and the decomposition of the document into distinct nodes means that the calling application is not concerned with the occasionally messy syntax of XML documents. For example, the clean separation of namespace nodes means that Namespaces, which are useful in combining specifications developed separately, have similar usefulness in combining applications developed separately. 3831f7d0a0bdec040f0834ea1d20b700682b6b7e 178 168 2017-01-05T22:59:30Z John 2 Remove broken syntax highlighting wikitext text/x-wiki __NOTOC__ <blockquote> &ldquo;I have a hard time arguing that anything in XML is generically useful any more except for the basic syntax, which lets us apply some very handy low-level tools like parsers and XSLT. The rest (XLink, schemas, etc.) has been a pointless trip into complexity.&rdquo; <cite>[http://lists.w3.org/Archives/Public/www-tag/2002Sep/0303.html Simon St.Laurent]</cite> </blockquote> <blockquote> &ldquo;My own experience is that having Prolog, Scheme, and Haskell available it'll take a gun pointed at my head or an extremely large bribe to make me use XSLT for anything.&rdquo; <cite>[http://cliplab.org/Mail/ciao-users/2001/000207.html Richard A. O'Keefe]</cite> </blockquote> ==Background== xml.pl is a module for parsing XML with Prolog, which provides Prolog applications with a simple 'Document Value Model' interface to XML documents. It has been used successfully in a number of applications. It supports a subset of XML suitable for XML Data and Worldwide Web applications but it is neither as strict nor as comprehensive as the [http://www.w3.org/TR/2000/REC-xml-20001006 XML 1.0 Specification] mandates. * It is not as strict because, while the specification must eliminate ambiguities, not all errors need to be regarded as faults, and some reasonable examples of real XML usage would have to be rejected if they were. * It is not as comprehensive because, where the XML specification makes provision for more or less complete DTDs to be provided as part of a document, xml.pl actions the local definition of ENTITIES only. Other DTD extensions are treated as commentary. ===Download the [[XML Module]] (xml.pl and plxml)=== xml.pl and plxml, a small Windows application which embodies xml.pl, have been placed into the public domain to encourage the use of Prolog with XML. I hope that they will be useful to you, but they are not supported, and they are provided without any warranty of any kind. ==Specification== Three predicates are exported by the module: <code>xml_parse/[2,3]</code>, <code>xml_subterm/2</code> and <code>xml_pp/1</code> . ====xml_parse( {+Controls,} +?Chars, ?+Document )==== parses <var>Chars</var>, a list of character codes, to/from <var>Document</var>, a data structure of the form <code>xml(Attributes, Content)</code>, where: ''Attributes'' is a list of ''Name''=''CharData'' attributes from the (possibly implicit) XML signature of the document. ''Content'' is a (possibly empty) list comprising occurrences of: ; <code>pcdata(CharData)</code> : Text ; <code>comment(CharData)</code> : An XML comment; ; <code>namespace(URI, Prefix, Element)</code> : a Namespace ; <code>element(Tag, Attributes, Content)</code> : <Tag>..</Tag> encloses Content or <Tag/> if Content is empty <nowiki>[]</nowiki>. ; <code>instructions(Name, CharData)</code> : A PI <?Name CharData?> ; <code>cdata(CharData)</code> : <![CDATA[CharData]]> ; <code>doctype(Tag, DoctypeId)</code> : DTD <!DOCTYPE .. > The conversions are not completely symmetrical in that weaker XML is accepted than can be generated. Specifically, in-bound ''(Chars -> Document)'' parsing does not require strictly well-formed XML. If <var>Chars</var> does not represent well-formed XML, <var>Document</var> is instantiated to the term <code>malformed(Attributes, Content)</code>. The ''Content'' of a ''malformed/2'' structure can include: ; <code>unparsed( CharData )</code> : Text which has not been parsed ; <code>out_of_context(Tag)</code> : <Tag> is not closed in addition to the parsed-term types. Out-bound ''(<var>Document</var> -> <var>Chars</var>)'' parsing ''does'' require that <var>Document</var> defines well-formed XML. If an error is detected, a 'domain' exception is raised. The domain exception will attempt to identify the particular sub-term in error, and will list the ancestor elements of the sub-term in error as <code>Tag{(Id)}</code> terms - where ''Id'' is the value of any attribute named id. The <var>Controls</var> applying to in-bound ''(<var>Chars</var> -> <var>Document</var>)'' parsing are: ; <code>extended_characters(Boolean)</code> : Use the extended character entities for XHTML (default true). ; <code>format(Boolean)</code> : Remove layouts when no non-layout character data appears between elements (default true). ; <code>remove_attribute_prefixes(Boolean)</code> : Remove redundant prefixes from attributes - i.e. prefixes denoting the namespace of the parent element (default false). ; <code> allow_ampersand(Boolean) </code> : Allow unescaped ampersand characters (&) to occur in PCDATA (default false). For out-bound ''(<var>Document</var> -> <var>Chars</var>)'' parsing, the only available option is: ; <code>format(Boolean)</code> : Indent the element content, (default true) ===Types=== ; Tag : An atom naming an element ; Name : An atom, not naming an element ; URI : An atom giving the URI of a Namespace ; CharData : A "string": list of character codes. ; DoctypeId : one of: <code>public(CharData,&nbsp;CharData&nbsp;{,&nbsp;DTDLiterals})</code>, <code>system(CharData&nbsp;{,&nbsp;DTDLiterals})</code> or <code>local{(DTDLiterals)}</code> ; DTDLiterals : A non-empty list of <code>dtd_literal(CharData)</code> terms - e.g. [http://www.w3.org/TR/2000/REC-xml-20001006#NT-AttlistDecl attribute-list declarations]. ; Boolean : one of <code>true</code> or <code>false</code> ====xml_subterm( +XMLTerm, ?Subterm )==== unifies <var>Subterm</var> with a sub-term of <var>XMLTerm</var>. This can be especially useful when trying to test or retrieve a deeply-nested subterm from a document, as demonstrated in the [[XML Query Use Cases with xml.pl]] examples. Note that <var>XMLTerm</var> is a sub-term of itself. ====xml_pp( +XMLDocument )==== "pretty prints" <var>XMLDocument</var> on the current output stream. ==Availability== On this site, you can download the [[XML Module]]. The module is also supplied as a library with the following Prologs: * It has been adapted for the [http://logtalk.org/ Logtalk Open source object-oriented extension to Prolog] by Paulo Moura. (See the folder "contributions/xml_parser" from release 2.29.1); * It is available in the [http://eclipseclp.org/ ECLiPSe Constraint Programming System], as a third-party library; * It has been ported to [http://www.picat-lang.org/bprolog/ B-Prolog] by Neng-Fa Zhou. * It has been adapted for [https://sicstus.sics.se/thirdparty.html SICStus Prolog] by Mats Carlsson. * It is included in [https://quintus.sics.se/ Quintus Prolog Release 3.5]. [[XML Query Use Cases with xml.pl]] is provided as an example to illustrate the way that the code can be used. ==Features of xml.pl== The <code>xml/2</code> data structure has some useful properties. ===Reusability=== Using a native Prolog representation of XML, in which terms represent document 'nodes', makes the parser reusable for any XML application. In effect, xml.pl encapsulates the application-independent tasks of document parsing and generation, which is essential where documents have components from more than one Namespace. ===Same Structure=== The Prolog term representing a document has the same structure as the document itself, which makes the correspondence between the literal representation of the Prolog term and the XML source readily apparent. For example, this simple [http://www.w3.org/Graphics/SVG/ SVG] image: <pre class="xml"> <?xml version="1.0" standalone="no"?> <!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.0//EN" "http://www.w3.org/.../svg10.dtd" [ <!ENTITY redblue "fill: red; stroke: blue; stroke-width: 1"> ]> <svg xmlns="http://www.w3.org/2000/svg" width="500" height="500"> <circle cx=" 25 " cy=" 25 " r=" 24 " style="&redblue;"/> </svg> </pre> ... translates into this Prolog term: <pre class="prolog"> xml( [version="1.0", standalone="no"], [ doctype( svg, public( "-//W3C//DTD SVG 1.0//EN", "http://www.w3.org/.../svg10.dtd" ) ), namespace( 'http://www.w3.org/2000/svg', "", element( svg, [width="500", height="500"], [ element( circle, [cx="25", cy="25", r="24", style="fill: red; stroke: blue; stroke-width: 1"], [] ) ] ) ) ] ). </pre> ===Efficient Manipulation=== Each type of node in an XML document is represented by a different Prolog functor, while data, (PCDATA, CDATA and Attribute Values), are left as "strings", (lists of character codes). The use of distinct functors for mark-up structures enables the efficient recursive traversal of a document, while leaving the data as strings facilitates the application-specific parsing of data content (aka [http://www.google.com/search?q=%22Micro-parsing%22+XML Micro-parsing]). For example, to turn every CDATA node into a PCDATA node with tabs expanded into spaces: <pre class="prolog"> cdata_to_pcdata( cdata(CharsWithTabs), pcdata(CharsWithSpaces) ) :- tab_expansion( CharsWithTabs, CharsWithSpaces ). cdata_to_pcdata( xml(Attributes, Content1), xml(Attributes, Content2) ) :- cdata_to_pcdata( Content1, Content2 ). cdata_to_pcdata( namespace(URI,Pfx,Content1), namespace(URI,Pfx,Content2) ) :- cdata_to_pcdata( Content1, Content2 ). cdata_to_pcdata( element(Name,Atts,Content1), element(Name,Atts,Content2) ) :- cdata_to_pcdata( Content1, Content2 ). cdata_to_pcdata( [], [] ). cdata_to_pcdata( [H1|T1], [H2|T2] ) :- cdata_to_pcdata( H1, H2 ), cdata_to_pcdata( T1, T2 ). cdata_to_pcdata( pcdata(Chars), pcdata(Chars) ). cdata_to_pcdata( comment(Chars), comment(Chars) ). cdata_to_pcdata( instructions(Name, Chars), instructions(Name, Chars) ). cdata_to_pcdata( doctype(Tag, DoctypeId), doctype(Tag, DoctypeId) ). </pre> The above uses no 'cuts', but will not create any choice points with ground input. ===Elegance=== The resolution of entity references and the decomposition of the document into distinct nodes means that the calling application is not concerned with the occasionally messy syntax of XML documents. For example, the clean separation of namespace nodes means that Namespaces, which are useful in combining specifications developed separately, have similar usefulness in combining applications developed separately. 8c999194c441990c7dc231a47b126012a6f224c2 184 178 2017-02-20T13:43:01Z John 2 /* Background */ wikitext text/x-wiki __NOTOC__ <blockquote> &ldquo;I have a hard time arguing that anything in XML is generically useful any more except for the basic syntax, which lets us apply some very handy low-level tools like parsers and XSLT. The rest (XLink, schemas, etc.) has been a pointless trip into complexity.&rdquo; <cite>[http://lists.w3.org/Archives/Public/www-tag/2002Sep/0303.html Simon St.Laurent]</cite> </blockquote> <blockquote> &ldquo;My own experience is that having Prolog, Scheme, and Haskell available it'll take a gun pointed at my head or an extremely large bribe to make me use XSLT for anything.&rdquo; <cite>[http://cliplab.org/Mail/ciao-users/2001/000207.html Richard A. O'Keefe]</cite> </blockquote> ==Background== xml.pl is a module for parsing XML with Prolog, which provides Prolog applications with a simple ''Document Value Model'' interface to XML documents. It has been used successfully in a number of applications. It supports a subset of XML suitable for XML Data and Worldwide Web applications but it is neither as strict nor as comprehensive as the [http://www.w3.org/TR/2000/REC-xml-20001006 XML 1.0 Specification] mandates. * It is not as strict because, while the specification must eliminate ambiguities, not all errors need to be regarded as faults, and some reasonable examples of real XML usage would have to be rejected if they were. * It is not as comprehensive because, where the XML specification makes provision for more or less complete DTDs to be provided as part of a document, xml.pl actions the local definition of ENTITIES only. Other DTD extensions are treated as commentary. ===Download the [[XML Module]] (xml.pl and plxml)=== xml.pl and plxml, a small Windows application which embodies xml.pl, have been placed into the public domain to encourage the use of Prolog with XML. I hope that they will be useful to you, but they are not supported, and they are provided without any warranty of any kind. ==Specification== Three predicates are exported by the module: <code>xml_parse/[2,3]</code>, <code>xml_subterm/2</code> and <code>xml_pp/1</code> . ====xml_parse( {+Controls,} +?Chars, ?+Document )==== parses <var>Chars</var>, a list of character codes, to/from <var>Document</var>, a data structure of the form <code>xml(Attributes, Content)</code>, where: ''Attributes'' is a list of ''Name''=''CharData'' attributes from the (possibly implicit) XML signature of the document. ''Content'' is a (possibly empty) list comprising occurrences of: ; <code>pcdata(CharData)</code> : Text ; <code>comment(CharData)</code> : An XML comment; ; <code>namespace(URI, Prefix, Element)</code> : a Namespace ; <code>element(Tag, Attributes, Content)</code> : <Tag>..</Tag> encloses Content or <Tag/> if Content is empty <nowiki>[]</nowiki>. ; <code>instructions(Name, CharData)</code> : A PI <?Name CharData?> ; <code>cdata(CharData)</code> : <![CDATA[CharData]]> ; <code>doctype(Tag, DoctypeId)</code> : DTD <!DOCTYPE .. > The conversions are not completely symmetrical in that weaker XML is accepted than can be generated. Specifically, in-bound ''(Chars -> Document)'' parsing does not require strictly well-formed XML. If <var>Chars</var> does not represent well-formed XML, <var>Document</var> is instantiated to the term <code>malformed(Attributes, Content)</code>. The ''Content'' of a ''malformed/2'' structure can include: ; <code>unparsed( CharData )</code> : Text which has not been parsed ; <code>out_of_context(Tag)</code> : <Tag> is not closed in addition to the parsed-term types. Out-bound ''(<var>Document</var> -> <var>Chars</var>)'' parsing ''does'' require that <var>Document</var> defines well-formed XML. If an error is detected, a 'domain' exception is raised. The domain exception will attempt to identify the particular sub-term in error, and will list the ancestor elements of the sub-term in error as <code>Tag{(Id)}</code> terms - where ''Id'' is the value of any attribute named id. The <var>Controls</var> applying to in-bound ''(<var>Chars</var> -> <var>Document</var>)'' parsing are: ; <code>extended_characters(Boolean)</code> : Use the extended character entities for XHTML (default true). ; <code>format(Boolean)</code> : Remove layouts when no non-layout character data appears between elements (default true). ; <code>remove_attribute_prefixes(Boolean)</code> : Remove redundant prefixes from attributes - i.e. prefixes denoting the namespace of the parent element (default false). ; <code> allow_ampersand(Boolean) </code> : Allow unescaped ampersand characters (&) to occur in PCDATA (default false). For out-bound ''(<var>Document</var> -> <var>Chars</var>)'' parsing, the only available option is: ; <code>format(Boolean)</code> : Indent the element content, (default true) ===Types=== ; Tag : An atom naming an element ; Name : An atom, not naming an element ; URI : An atom giving the URI of a Namespace ; CharData : A "string": list of character codes. ; DoctypeId : one of: <code>public(CharData,&nbsp;CharData&nbsp;{,&nbsp;DTDLiterals})</code>, <code>system(CharData&nbsp;{,&nbsp;DTDLiterals})</code> or <code>local{(DTDLiterals)}</code> ; DTDLiterals : A non-empty list of <code>dtd_literal(CharData)</code> terms - e.g. [http://www.w3.org/TR/2000/REC-xml-20001006#NT-AttlistDecl attribute-list declarations]. ; Boolean : one of <code>true</code> or <code>false</code> ====xml_subterm( +XMLTerm, ?Subterm )==== unifies <var>Subterm</var> with a sub-term of <var>XMLTerm</var>. This can be especially useful when trying to test or retrieve a deeply-nested subterm from a document, as demonstrated in the [[XML Query Use Cases with xml.pl]] examples. Note that <var>XMLTerm</var> is a sub-term of itself. ====xml_pp( +XMLDocument )==== "pretty prints" <var>XMLDocument</var> on the current output stream. ==Availability== On this site, you can download the [[XML Module]]. The module is also supplied as a library with the following Prologs: * It has been adapted for the [http://logtalk.org/ Logtalk Open source object-oriented extension to Prolog] by Paulo Moura. (See the folder "contributions/xml_parser" from release 2.29.1); * It is available in the [http://eclipseclp.org/ ECLiPSe Constraint Programming System], as a third-party library; * It has been ported to [http://www.picat-lang.org/bprolog/ B-Prolog] by Neng-Fa Zhou. * It has been adapted for [https://sicstus.sics.se/thirdparty.html SICStus Prolog] by Mats Carlsson. * It is included in [https://quintus.sics.se/ Quintus Prolog Release 3.5]. [[XML Query Use Cases with xml.pl]] is provided as an example to illustrate the way that the code can be used. ==Features of xml.pl== The <code>xml/2</code> data structure has some useful properties. ===Reusability=== Using a native Prolog representation of XML, in which terms represent document 'nodes', makes the parser reusable for any XML application. In effect, xml.pl encapsulates the application-independent tasks of document parsing and generation, which is essential where documents have components from more than one Namespace. ===Same Structure=== The Prolog term representing a document has the same structure as the document itself, which makes the correspondence between the literal representation of the Prolog term and the XML source readily apparent. For example, this simple [http://www.w3.org/Graphics/SVG/ SVG] image: <pre class="xml"> <?xml version="1.0" standalone="no"?> <!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.0//EN" "http://www.w3.org/.../svg10.dtd" [ <!ENTITY redblue "fill: red; stroke: blue; stroke-width: 1"> ]> <svg xmlns="http://www.w3.org/2000/svg" width="500" height="500"> <circle cx=" 25 " cy=" 25 " r=" 24 " style="&redblue;"/> </svg> </pre> ... translates into this Prolog term: <pre class="prolog"> xml( [version="1.0", standalone="no"], [ doctype( svg, public( "-//W3C//DTD SVG 1.0//EN", "http://www.w3.org/.../svg10.dtd" ) ), namespace( 'http://www.w3.org/2000/svg', "", element( svg, [width="500", height="500"], [ element( circle, [cx="25", cy="25", r="24", style="fill: red; stroke: blue; stroke-width: 1"], [] ) ] ) ) ] ). </pre> ===Efficient Manipulation=== Each type of node in an XML document is represented by a different Prolog functor, while data, (PCDATA, CDATA and Attribute Values), are left as "strings", (lists of character codes). The use of distinct functors for mark-up structures enables the efficient recursive traversal of a document, while leaving the data as strings facilitates the application-specific parsing of data content (aka [http://www.google.com/search?q=%22Micro-parsing%22+XML Micro-parsing]). For example, to turn every CDATA node into a PCDATA node with tabs expanded into spaces: <pre class="prolog"> cdata_to_pcdata( cdata(CharsWithTabs), pcdata(CharsWithSpaces) ) :- tab_expansion( CharsWithTabs, CharsWithSpaces ). cdata_to_pcdata( xml(Attributes, Content1), xml(Attributes, Content2) ) :- cdata_to_pcdata( Content1, Content2 ). cdata_to_pcdata( namespace(URI,Pfx,Content1), namespace(URI,Pfx,Content2) ) :- cdata_to_pcdata( Content1, Content2 ). cdata_to_pcdata( element(Name,Atts,Content1), element(Name,Atts,Content2) ) :- cdata_to_pcdata( Content1, Content2 ). cdata_to_pcdata( [], [] ). cdata_to_pcdata( [H1|T1], [H2|T2] ) :- cdata_to_pcdata( H1, H2 ), cdata_to_pcdata( T1, T2 ). cdata_to_pcdata( pcdata(Chars), pcdata(Chars) ). cdata_to_pcdata( comment(Chars), comment(Chars) ). cdata_to_pcdata( instructions(Name, Chars), instructions(Name, Chars) ). cdata_to_pcdata( doctype(Tag, DoctypeId), doctype(Tag, DoctypeId) ). </pre> The above uses no 'cuts', but will not create any choice points with ground input. ===Elegance=== The resolution of entity references and the decomposition of the document into distinct nodes means that the calling application is not concerned with the occasionally messy syntax of XML documents. For example, the clean separation of namespace nodes means that Namespaces, which are useful in combining specifications developed separately, have similar usefulness in combining applications developed separately. d52e5da0057a63f3afe77de498b4ca90e29bbd06 185 184 2017-02-20T13:44:40Z John 2 /* Availability */ wikitext text/x-wiki __NOTOC__ <blockquote> &ldquo;I have a hard time arguing that anything in XML is generically useful any more except for the basic syntax, which lets us apply some very handy low-level tools like parsers and XSLT. The rest (XLink, schemas, etc.) has been a pointless trip into complexity.&rdquo; <cite>[http://lists.w3.org/Archives/Public/www-tag/2002Sep/0303.html Simon St.Laurent]</cite> </blockquote> <blockquote> &ldquo;My own experience is that having Prolog, Scheme, and Haskell available it'll take a gun pointed at my head or an extremely large bribe to make me use XSLT for anything.&rdquo; <cite>[http://cliplab.org/Mail/ciao-users/2001/000207.html Richard A. O'Keefe]</cite> </blockquote> ==Background== xml.pl is a module for parsing XML with Prolog, which provides Prolog applications with a simple ''Document Value Model'' interface to XML documents. It has been used successfully in a number of applications. It supports a subset of XML suitable for XML Data and Worldwide Web applications but it is neither as strict nor as comprehensive as the [http://www.w3.org/TR/2000/REC-xml-20001006 XML 1.0 Specification] mandates. * It is not as strict because, while the specification must eliminate ambiguities, not all errors need to be regarded as faults, and some reasonable examples of real XML usage would have to be rejected if they were. * It is not as comprehensive because, where the XML specification makes provision for more or less complete DTDs to be provided as part of a document, xml.pl actions the local definition of ENTITIES only. Other DTD extensions are treated as commentary. ===Download the [[XML Module]] (xml.pl and plxml)=== xml.pl and plxml, a small Windows application which embodies xml.pl, have been placed into the public domain to encourage the use of Prolog with XML. I hope that they will be useful to you, but they are not supported, and they are provided without any warranty of any kind. ==Specification== Three predicates are exported by the module: <code>xml_parse/[2,3]</code>, <code>xml_subterm/2</code> and <code>xml_pp/1</code> . ====xml_parse( {+Controls,} +?Chars, ?+Document )==== parses <var>Chars</var>, a list of character codes, to/from <var>Document</var>, a data structure of the form <code>xml(Attributes, Content)</code>, where: ''Attributes'' is a list of ''Name''=''CharData'' attributes from the (possibly implicit) XML signature of the document. ''Content'' is a (possibly empty) list comprising occurrences of: ; <code>pcdata(CharData)</code> : Text ; <code>comment(CharData)</code> : An XML comment; ; <code>namespace(URI, Prefix, Element)</code> : a Namespace ; <code>element(Tag, Attributes, Content)</code> : <Tag>..</Tag> encloses Content or <Tag/> if Content is empty <nowiki>[]</nowiki>. ; <code>instructions(Name, CharData)</code> : A PI <?Name CharData?> ; <code>cdata(CharData)</code> : <![CDATA[CharData]]> ; <code>doctype(Tag, DoctypeId)</code> : DTD <!DOCTYPE .. > The conversions are not completely symmetrical in that weaker XML is accepted than can be generated. Specifically, in-bound ''(Chars -> Document)'' parsing does not require strictly well-formed XML. If <var>Chars</var> does not represent well-formed XML, <var>Document</var> is instantiated to the term <code>malformed(Attributes, Content)</code>. The ''Content'' of a ''malformed/2'' structure can include: ; <code>unparsed( CharData )</code> : Text which has not been parsed ; <code>out_of_context(Tag)</code> : <Tag> is not closed in addition to the parsed-term types. Out-bound ''(<var>Document</var> -> <var>Chars</var>)'' parsing ''does'' require that <var>Document</var> defines well-formed XML. If an error is detected, a 'domain' exception is raised. The domain exception will attempt to identify the particular sub-term in error, and will list the ancestor elements of the sub-term in error as <code>Tag{(Id)}</code> terms - where ''Id'' is the value of any attribute named id. The <var>Controls</var> applying to in-bound ''(<var>Chars</var> -> <var>Document</var>)'' parsing are: ; <code>extended_characters(Boolean)</code> : Use the extended character entities for XHTML (default true). ; <code>format(Boolean)</code> : Remove layouts when no non-layout character data appears between elements (default true). ; <code>remove_attribute_prefixes(Boolean)</code> : Remove redundant prefixes from attributes - i.e. prefixes denoting the namespace of the parent element (default false). ; <code> allow_ampersand(Boolean) </code> : Allow unescaped ampersand characters (&) to occur in PCDATA (default false). For out-bound ''(<var>Document</var> -> <var>Chars</var>)'' parsing, the only available option is: ; <code>format(Boolean)</code> : Indent the element content, (default true) ===Types=== ; Tag : An atom naming an element ; Name : An atom, not naming an element ; URI : An atom giving the URI of a Namespace ; CharData : A "string": list of character codes. ; DoctypeId : one of: <code>public(CharData,&nbsp;CharData&nbsp;{,&nbsp;DTDLiterals})</code>, <code>system(CharData&nbsp;{,&nbsp;DTDLiterals})</code> or <code>local{(DTDLiterals)}</code> ; DTDLiterals : A non-empty list of <code>dtd_literal(CharData)</code> terms - e.g. [http://www.w3.org/TR/2000/REC-xml-20001006#NT-AttlistDecl attribute-list declarations]. ; Boolean : one of <code>true</code> or <code>false</code> ====xml_subterm( +XMLTerm, ?Subterm )==== unifies <var>Subterm</var> with a sub-term of <var>XMLTerm</var>. This can be especially useful when trying to test or retrieve a deeply-nested subterm from a document, as demonstrated in the [[XML Query Use Cases with xml.pl]] examples. Note that <var>XMLTerm</var> is a sub-term of itself. ====xml_pp( +XMLDocument )==== "pretty prints" <var>XMLDocument</var> on the current output stream. ==Availability== On this site, you can download the [[XML Module]]. The module is also supplied as a library with the following Prologs: * It has been adapted for the [http://logtalk.org/ Logtalk Open source object-oriented extension to Prolog] by Paulo Moura. (See the folder "contributions/xml_parser" from release 2.29.1); * It is available in the [http://eclipseclp.org/ ECLiPSe Constraint Programming System], as a third-party library; * It has been ported to [http://www.picat-lang.org/bprolog/ B-Prolog] by Neng-Fa Zhou. * It has been adapted for [https://sicstus.sics.se/thirdparty.html SICStus Prolog] by Mats Carlsson. * It is included in [https://quintus.sics.se/ Quintus Prolog Release 3.5]. [[XML Query Use Cases with xml.pl]] provides examples of the ways that the code can be used. ==Features of xml.pl== The <code>xml/2</code> data structure has some useful properties. ===Reusability=== Using a native Prolog representation of XML, in which terms represent document 'nodes', makes the parser reusable for any XML application. In effect, xml.pl encapsulates the application-independent tasks of document parsing and generation, which is essential where documents have components from more than one Namespace. ===Same Structure=== The Prolog term representing a document has the same structure as the document itself, which makes the correspondence between the literal representation of the Prolog term and the XML source readily apparent. For example, this simple [http://www.w3.org/Graphics/SVG/ SVG] image: <pre class="xml"> <?xml version="1.0" standalone="no"?> <!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.0//EN" "http://www.w3.org/.../svg10.dtd" [ <!ENTITY redblue "fill: red; stroke: blue; stroke-width: 1"> ]> <svg xmlns="http://www.w3.org/2000/svg" width="500" height="500"> <circle cx=" 25 " cy=" 25 " r=" 24 " style="&redblue;"/> </svg> </pre> ... translates into this Prolog term: <pre class="prolog"> xml( [version="1.0", standalone="no"], [ doctype( svg, public( "-//W3C//DTD SVG 1.0//EN", "http://www.w3.org/.../svg10.dtd" ) ), namespace( 'http://www.w3.org/2000/svg', "", element( svg, [width="500", height="500"], [ element( circle, [cx="25", cy="25", r="24", style="fill: red; stroke: blue; stroke-width: 1"], [] ) ] ) ) ] ). </pre> ===Efficient Manipulation=== Each type of node in an XML document is represented by a different Prolog functor, while data, (PCDATA, CDATA and Attribute Values), are left as "strings", (lists of character codes). The use of distinct functors for mark-up structures enables the efficient recursive traversal of a document, while leaving the data as strings facilitates the application-specific parsing of data content (aka [http://www.google.com/search?q=%22Micro-parsing%22+XML Micro-parsing]). For example, to turn every CDATA node into a PCDATA node with tabs expanded into spaces: <pre class="prolog"> cdata_to_pcdata( cdata(CharsWithTabs), pcdata(CharsWithSpaces) ) :- tab_expansion( CharsWithTabs, CharsWithSpaces ). cdata_to_pcdata( xml(Attributes, Content1), xml(Attributes, Content2) ) :- cdata_to_pcdata( Content1, Content2 ). cdata_to_pcdata( namespace(URI,Pfx,Content1), namespace(URI,Pfx,Content2) ) :- cdata_to_pcdata( Content1, Content2 ). cdata_to_pcdata( element(Name,Atts,Content1), element(Name,Atts,Content2) ) :- cdata_to_pcdata( Content1, Content2 ). cdata_to_pcdata( [], [] ). cdata_to_pcdata( [H1|T1], [H2|T2] ) :- cdata_to_pcdata( H1, H2 ), cdata_to_pcdata( T1, T2 ). cdata_to_pcdata( pcdata(Chars), pcdata(Chars) ). cdata_to_pcdata( comment(Chars), comment(Chars) ). cdata_to_pcdata( instructions(Name, Chars), instructions(Name, Chars) ). cdata_to_pcdata( doctype(Tag, DoctypeId), doctype(Tag, DoctypeId) ). </pre> The above uses no 'cuts', but will not create any choice points with ground input. ===Elegance=== The resolution of entity references and the decomposition of the document into distinct nodes means that the calling application is not concerned with the occasionally messy syntax of XML documents. For example, the clean separation of namespace nodes means that Namespaces, which are useful in combining specifications developed separately, have similar usefulness in combining applications developed separately. 3c50609be8a58252b268fbdd137e4144db5cd770 193 185 2017-10-09T21:34:28Z John 2 The Micro-parsing link to Google Search was supposed to be temporary, until a good reference turned up. wikitext text/x-wiki __NOTOC__ <blockquote> &ldquo;I have a hard time arguing that anything in XML is generically useful any more except for the basic syntax, which lets us apply some very handy low-level tools like parsers and XSLT. The rest (XLink, schemas, etc.) has been a pointless trip into complexity.&rdquo; <cite>[http://lists.w3.org/Archives/Public/www-tag/2002Sep/0303.html Simon St.Laurent]</cite> </blockquote> <blockquote> &ldquo;My own experience is that having Prolog, Scheme, and Haskell available it'll take a gun pointed at my head or an extremely large bribe to make me use XSLT for anything.&rdquo; <cite>[http://cliplab.org/Mail/ciao-users/2001/000207.html Richard A. O'Keefe]</cite> </blockquote> ==Background== xml.pl is a module for parsing XML with Prolog, which provides Prolog applications with a simple ''Document Value Model'' interface to XML documents. It has been used successfully in a number of applications. It supports a subset of XML suitable for XML Data and Worldwide Web applications but it is neither as strict nor as comprehensive as the [http://www.w3.org/TR/2000/REC-xml-20001006 XML 1.0 Specification] mandates. * It is not as strict because, while the specification must eliminate ambiguities, not all errors need to be regarded as faults, and some reasonable examples of real XML usage would have to be rejected if they were. * It is not as comprehensive because, where the XML specification makes provision for more or less complete DTDs to be provided as part of a document, xml.pl actions the local definition of ENTITIES only. Other DTD extensions are treated as commentary. ===Download the [[XML Module]] (xml.pl and plxml)=== xml.pl and plxml, a small Windows application which embodies xml.pl, have been placed into the public domain to encourage the use of Prolog with XML. I hope that they will be useful to you, but they are not supported, and they are provided without any warranty of any kind. ==Specification== Three predicates are exported by the module: <code>xml_parse/[2,3]</code>, <code>xml_subterm/2</code> and <code>xml_pp/1</code> . ====xml_parse( {+Controls,} +?Chars, ?+Document )==== parses <var>Chars</var>, a list of character codes, to/from <var>Document</var>, a data structure of the form <code>xml(Attributes, Content)</code>, where: ''Attributes'' is a list of ''Name''=''CharData'' attributes from the (possibly implicit) XML signature of the document. ''Content'' is a (possibly empty) list comprising occurrences of: ; <code>pcdata(CharData)</code> : Text ; <code>comment(CharData)</code> : An XML comment; ; <code>namespace(URI, Prefix, Element)</code> : a Namespace ; <code>element(Tag, Attributes, Content)</code> : <Tag>..</Tag> encloses Content or <Tag/> if Content is empty <nowiki>[]</nowiki>. ; <code>instructions(Name, CharData)</code> : A PI <?Name CharData?> ; <code>cdata(CharData)</code> : <![CDATA[CharData]]> ; <code>doctype(Tag, DoctypeId)</code> : DTD <!DOCTYPE .. > The conversions are not completely symmetrical in that weaker XML is accepted than can be generated. Specifically, in-bound ''(Chars -> Document)'' parsing does not require strictly well-formed XML. If <var>Chars</var> does not represent well-formed XML, <var>Document</var> is instantiated to the term <code>malformed(Attributes, Content)</code>. The ''Content'' of a ''malformed/2'' structure can include: ; <code>unparsed( CharData )</code> : Text which has not been parsed ; <code>out_of_context(Tag)</code> : <Tag> is not closed in addition to the parsed-term types. Out-bound ''(<var>Document</var> -> <var>Chars</var>)'' parsing ''does'' require that <var>Document</var> defines well-formed XML. If an error is detected, a 'domain' exception is raised. The domain exception will attempt to identify the particular sub-term in error, and will list the ancestor elements of the sub-term in error as <code>Tag{(Id)}</code> terms - where ''Id'' is the value of any attribute named id. The <var>Controls</var> applying to in-bound ''(<var>Chars</var> -> <var>Document</var>)'' parsing are: ; <code>extended_characters(Boolean)</code> : Use the extended character entities for XHTML (default true). ; <code>format(Boolean)</code> : Remove layouts when no non-layout character data appears between elements (default true). ; <code>remove_attribute_prefixes(Boolean)</code> : Remove redundant prefixes from attributes - i.e. prefixes denoting the namespace of the parent element (default false). ; <code> allow_ampersand(Boolean) </code> : Allow unescaped ampersand characters (&) to occur in PCDATA (default false). For out-bound ''(<var>Document</var> -> <var>Chars</var>)'' parsing, the only available option is: ; <code>format(Boolean)</code> : Indent the element content, (default true) ===Types=== ; Tag : An atom naming an element ; Name : An atom, not naming an element ; URI : An atom giving the URI of a Namespace ; CharData : A "string": list of character codes. ; DoctypeId : one of: <code>public(CharData,&nbsp;CharData&nbsp;{,&nbsp;DTDLiterals})</code>, <code>system(CharData&nbsp;{,&nbsp;DTDLiterals})</code> or <code>local{(DTDLiterals)}</code> ; DTDLiterals : A non-empty list of <code>dtd_literal(CharData)</code> terms - e.g. [http://www.w3.org/TR/2000/REC-xml-20001006#NT-AttlistDecl attribute-list declarations]. ; Boolean : one of <code>true</code> or <code>false</code> ====xml_subterm( +XMLTerm, ?Subterm )==== unifies <var>Subterm</var> with a sub-term of <var>XMLTerm</var>. This can be especially useful when trying to test or retrieve a deeply-nested subterm from a document, as demonstrated in the [[XML Query Use Cases with xml.pl]] examples. Note that <var>XMLTerm</var> is a sub-term of itself. ====xml_pp( +XMLDocument )==== "pretty prints" <var>XMLDocument</var> on the current output stream. ==Availability== On this site, you can download the [[XML Module]]. The module is also supplied as a library with the following Prologs: * It has been adapted for the [http://logtalk.org/ Logtalk Open source object-oriented extension to Prolog] by Paulo Moura. (See the folder "contributions/xml_parser" from release 2.29.1); * It is available in the [http://eclipseclp.org/ ECLiPSe Constraint Programming System], as a third-party library; * It has been ported to [http://www.picat-lang.org/bprolog/ B-Prolog] by Neng-Fa Zhou. * It has been adapted for [https://sicstus.sics.se/thirdparty.html SICStus Prolog] by Mats Carlsson. * It is included in [https://quintus.sics.se/ Quintus Prolog Release 3.5]. [[XML Query Use Cases with xml.pl]] provides examples of the ways that the code can be used. ==Features of xml.pl== The <code>xml/2</code> data structure has some useful properties. ===Reusability=== Using a native Prolog representation of XML, in which terms represent document 'nodes', makes the parser reusable for any XML application. In effect, xml.pl encapsulates the application-independent tasks of document parsing and generation, which is essential where documents have components from more than one Namespace. ===Same Structure=== The Prolog term representing a document has the same structure as the document itself, which makes the correspondence between the literal representation of the Prolog term and the XML source readily apparent. For example, this simple [http://www.w3.org/Graphics/SVG/ SVG] image: <pre class="xml"> <?xml version="1.0" standalone="no"?> <!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.0//EN" "http://www.w3.org/.../svg10.dtd" [ <!ENTITY redblue "fill: red; stroke: blue; stroke-width: 1"> ]> <svg xmlns="http://www.w3.org/2000/svg" width="500" height="500"> <circle cx=" 25 " cy=" 25 " r=" 24 " style="&redblue;"/> </svg> </pre> ... translates into this Prolog term: <pre class="prolog"> xml( [version="1.0", standalone="no"], [ doctype( svg, public( "-//W3C//DTD SVG 1.0//EN", "http://www.w3.org/.../svg10.dtd" ) ), namespace( 'http://www.w3.org/2000/svg', "", element( svg, [width="500", height="500"], [ element( circle, [cx="25", cy="25", r="24", style="fill: red; stroke: blue; stroke-width: 1"], [] ) ] ) ) ] ). </pre> ===Efficient Manipulation=== Each type of node in an XML document is represented by a different Prolog functor, while data, (PCDATA, CDATA and Attribute Values), are left as "strings", (lists of character codes). The use of distinct functors for mark-up structures enables the efficient recursive traversal of a document, while leaving the data as strings facilitates the application-specific parsing of data content (aka Micro-parsing). For example, to turn every CDATA node into a PCDATA node with tabs expanded into spaces: <pre class="prolog"> cdata_to_pcdata( cdata(CharsWithTabs), pcdata(CharsWithSpaces) ) :- tab_expansion( CharsWithTabs, CharsWithSpaces ). cdata_to_pcdata( xml(Attributes, Content1), xml(Attributes, Content2) ) :- cdata_to_pcdata( Content1, Content2 ). cdata_to_pcdata( namespace(URI,Pfx,Content1), namespace(URI,Pfx,Content2) ) :- cdata_to_pcdata( Content1, Content2 ). cdata_to_pcdata( element(Name,Atts,Content1), element(Name,Atts,Content2) ) :- cdata_to_pcdata( Content1, Content2 ). cdata_to_pcdata( [], [] ). cdata_to_pcdata( [H1|T1], [H2|T2] ) :- cdata_to_pcdata( H1, H2 ), cdata_to_pcdata( T1, T2 ). cdata_to_pcdata( pcdata(Chars), pcdata(Chars) ). cdata_to_pcdata( comment(Chars), comment(Chars) ). cdata_to_pcdata( instructions(Name, Chars), instructions(Name, Chars) ). cdata_to_pcdata( doctype(Tag, DoctypeId), doctype(Tag, DoctypeId) ). </pre> The above uses no 'cuts', but will not create any choice points with ground input. ===Elegance=== The resolution of entity references and the decomposition of the document into distinct nodes means that the calling application is not concerned with the occasionally messy syntax of XML documents. For example, the clean separation of namespace nodes means that Namespaces, which are useful in combining specifications developed separately, have similar usefulness in combining applications developed separately. 3b45ff86968da9a08706a09b6749fda1c56ca902 0 20 161 135 2016-05-22T00:28:29Z John 2 /* Porting PiLLoW to Quintus Prolog 3.X */ Updated PiLLoW link wikitext text/x-wiki == Porting PiLLoW to Quintus Prolog 3.X == The [http://cliplab.org/miscdocs/pillow/pillow.html PiLLoW] library provides predicates for developing HTTP client and server applications. For client applications, it provides mechanisms to retrieve HTML files and to parse HTML into useful Prolog terms. For server applications, it provides a predicate to access CGI query parameters, so that a Prolog application can be used to handle form input directly i.e. without additional scripting. Additionally, HTML parsing supports the reverse translation of terms into HTML, so that forms can be generated. ==PiLLoW 1.1== If you want to port [http://clip.dia.fi.upm.es/miscdocs/pillow/pillow.html PiLLoW 1.1] to [http://quintus.sics.se/ Quintus Prolog], the following notes may be of use. ===http_transaction/5=== must be rewritten to use the Quintus tcp and socketio libraries. ====http_transaction(+Host, +Port, +Request, +Timeout, -Response)==== Sends an HTTP <var>Request</var> to an HTTP server <var>Host</var>:<var>Port</var> and returns the resulting message in <var>Response</var>. <var>Timeout</var> defines the maximum number of seconds to wait for a response. <syntaxhighlight lang="prolog"> :- use_module(library(tcp)). :- use_module(library(socketio)). :- use_module(library(date), [now/1]). http_transaction( Host, Port, Request, Timeout, Response ) :- tcp:connect( Host, Port, Socket ), Socket >= 0, % Fail if connect error socket_io_open_output( Socket, Ocode ), stream_code( OStream, Ocode ), write_string( OStream, Request ), close( OStream ), socket_io_open_input( Socket, Icode ), stream_code( IStream, Icode ), now( Now ), http_transaction1( Now, Socket, IStream, Timeout, Response ), close( IStream ), tcp:tcp_shutdown( Socket, _Status ), Response \== timeout. http_transaction1( Now, Socket, IStream, Timeout, Response ) :- tcp:tcp_select( 0, Timeout, FD, Status ), http_transaction2( Status, Now, Socket, FD, IStream, Timeout, Response ). http_transaction2( 1, Then, Socket, FD, IStream, Timeout, Response ) :- ( Socket == FD -> stream_to_string( IStream, Response ) ; otherwise -> now( Now ), Elapsed is Now - Then, ( Elapsed < Timeout -> Timeout1 is Timeout - Elapsed, http_transaction1( Now, Socket, IStream, Timeout1, Response ) ; otherwise -> Response = timeout ) ). http_transaction2( 0, _Then, _Socket, _FD, _IStream, _Timeout, timeout ). http_transaction2( -1, _Then, Socket, _FD, IStream, Timeout, _Response ) :- raise_exception( socket_error(Socket, IStream, Timeout) ). getenvstr( Var, Chars ) :- environ( Var, Atom ), atom_chars( Atom, Chars ). :- use_module( library(environ), [environ/2] ). </syntaxhighlight> The ISO Prolog predicates used in PiLLoW can be mapped to equivalent Quintus built-in predicates. <syntaxhighlight lang="prolog">flush_output :- ttyflush. atom_codes( Atom, Codes ) :- atom_chars( Atom, Codes ). catch( Goal, Error, Action ) :- on_exception( Error, Goal, Action ). get_code( Code ) :- get0( Code ). get_code( Stream, Code ) :- get0( Stream, Code ). include( File ) :- ensure_loaded( File ). number_codes( Number, Codes ) :- number_chars( Number, Codes ). put_code( Code ) :- put( Code ).</syntaxhighlight> Similarly, some library predicates are not defined/defined differently in Quintus: <syntaxhighlight lang="prolog">atom_concat( A, B, AB ) :- name( A, AS ), name( B, BS ), append( AS, BS, ABS ), atom_chars( AB, ABS ). getenv( Var, QueryString ) :- environ( Var, QueryString ). :- use_module( library(environ), [environ/2] ).</syntaxhighlight> ==Pillow 1.0== I have ported PiLLoW 1.0 to use the [http://quintus.sics.se/ Quintus Prolog] 3.X libraries, and made it available as a [https://binding-time.co.uk/download/pillow.zip 260Kb Zip file]. It is offered here as free, '''unsupported''' source code, for which the author accepts no liability whatsoever. '''''Note:''''' The parsing of &quot;multipart&quot; form data on win32 can produce errors, when binary files are submitted, e.g. sending image files as part of the form input. This is because the default for &quot;stdin&quot; on win32 is &quot;text&quot;. 17035093d7f45099bfce705e4e71b2dcb087201b 162 161 2016-05-22T00:29:25Z John 2 /* PiLLoW 1.1 */ wikitext text/x-wiki == Porting PiLLoW to Quintus Prolog 3.X == The [http://cliplab.org/miscdocs/pillow/pillow.html PiLLoW] library provides predicates for developing HTTP client and server applications. For client applications, it provides mechanisms to retrieve HTML files and to parse HTML into useful Prolog terms. For server applications, it provides a predicate to access CGI query parameters, so that a Prolog application can be used to handle form input directly i.e. without additional scripting. Additionally, HTML parsing supports the reverse translation of terms into HTML, so that forms can be generated. ==PiLLoW 1.1== If you want to port [http://cliplab.org/miscdocs/pillow/pillow.html PiLLoW 1.1] to [http://quintus.sics.se/ Quintus Prolog], the following notes may be of use. ===http_transaction/5=== must be rewritten to use the Quintus tcp and socketio libraries. ====http_transaction(+Host, +Port, +Request, +Timeout, -Response)==== Sends an HTTP <var>Request</var> to an HTTP server <var>Host</var>:<var>Port</var> and returns the resulting message in <var>Response</var>. <var>Timeout</var> defines the maximum number of seconds to wait for a response. <syntaxhighlight lang="prolog"> :- use_module(library(tcp)). :- use_module(library(socketio)). :- use_module(library(date), [now/1]). http_transaction( Host, Port, Request, Timeout, Response ) :- tcp:connect( Host, Port, Socket ), Socket >= 0, % Fail if connect error socket_io_open_output( Socket, Ocode ), stream_code( OStream, Ocode ), write_string( OStream, Request ), close( OStream ), socket_io_open_input( Socket, Icode ), stream_code( IStream, Icode ), now( Now ), http_transaction1( Now, Socket, IStream, Timeout, Response ), close( IStream ), tcp:tcp_shutdown( Socket, _Status ), Response \== timeout. http_transaction1( Now, Socket, IStream, Timeout, Response ) :- tcp:tcp_select( 0, Timeout, FD, Status ), http_transaction2( Status, Now, Socket, FD, IStream, Timeout, Response ). http_transaction2( 1, Then, Socket, FD, IStream, Timeout, Response ) :- ( Socket == FD -> stream_to_string( IStream, Response ) ; otherwise -> now( Now ), Elapsed is Now - Then, ( Elapsed < Timeout -> Timeout1 is Timeout - Elapsed, http_transaction1( Now, Socket, IStream, Timeout1, Response ) ; otherwise -> Response = timeout ) ). http_transaction2( 0, _Then, _Socket, _FD, _IStream, _Timeout, timeout ). http_transaction2( -1, _Then, Socket, _FD, IStream, Timeout, _Response ) :- raise_exception( socket_error(Socket, IStream, Timeout) ). getenvstr( Var, Chars ) :- environ( Var, Atom ), atom_chars( Atom, Chars ). :- use_module( library(environ), [environ/2] ). </syntaxhighlight> The ISO Prolog predicates used in PiLLoW can be mapped to equivalent Quintus built-in predicates. <syntaxhighlight lang="prolog">flush_output :- ttyflush. atom_codes( Atom, Codes ) :- atom_chars( Atom, Codes ). catch( Goal, Error, Action ) :- on_exception( Error, Goal, Action ). get_code( Code ) :- get0( Code ). get_code( Stream, Code ) :- get0( Stream, Code ). include( File ) :- ensure_loaded( File ). number_codes( Number, Codes ) :- number_chars( Number, Codes ). put_code( Code ) :- put( Code ).</syntaxhighlight> Similarly, some library predicates are not defined/defined differently in Quintus: <syntaxhighlight lang="prolog">atom_concat( A, B, AB ) :- name( A, AS ), name( B, BS ), append( AS, BS, ABS ), atom_chars( AB, ABS ). getenv( Var, QueryString ) :- environ( Var, QueryString ). :- use_module( library(environ), [environ/2] ).</syntaxhighlight> ==Pillow 1.0== I have ported PiLLoW 1.0 to use the [http://quintus.sics.se/ Quintus Prolog] 3.X libraries, and made it available as a [https://binding-time.co.uk/download/pillow.zip 260Kb Zip file]. It is offered here as free, '''unsupported''' source code, for which the author accepts no liability whatsoever. '''''Note:''''' The parsing of &quot;multipart&quot; form data on win32 can produce errors, when binary files are submitted, e.g. sending image files as part of the form input. This is because the default for &quot;stdin&quot; on win32 is &quot;text&quot;. 5534b6328a5669f4ee6c8b6666d18ca810804cd0 177 162 2017-01-05T22:57:09Z John 2 Remove broken syntax highlighting wikitext text/x-wiki == Porting PiLLoW to Quintus Prolog 3.X == The [http://cliplab.org/miscdocs/pillow/pillow.html PiLLoW] library provides predicates for developing HTTP client and server applications. For client applications, it provides mechanisms to retrieve HTML files and to parse HTML into useful Prolog terms. For server applications, it provides a predicate to access CGI query parameters, so that a Prolog application can be used to handle form input directly i.e. without additional scripting. Additionally, HTML parsing supports the reverse translation of terms into HTML, so that forms can be generated. ==PiLLoW 1.1== If you want to port [http://cliplab.org/miscdocs/pillow/pillow.html PiLLoW 1.1] to [http://quintus.sics.se/ Quintus Prolog], the following notes may be of use. ===http_transaction/5=== must be rewritten to use the Quintus tcp and socketio libraries. ====http_transaction(+Host, +Port, +Request, +Timeout, -Response)==== Sends an HTTP <var>Request</var> to an HTTP server <var>Host</var>:<var>Port</var> and returns the resulting message in <var>Response</var>. <var>Timeout</var> defines the maximum number of seconds to wait for a response. <pre class="prolog"> :- use_module(library(tcp)). :- use_module(library(socketio)). :- use_module(library(date), [now/1]). http_transaction( Host, Port, Request, Timeout, Response ) :- tcp:connect( Host, Port, Socket ), Socket >= 0, % Fail if connect error socket_io_open_output( Socket, Ocode ), stream_code( OStream, Ocode ), write_string( OStream, Request ), close( OStream ), socket_io_open_input( Socket, Icode ), stream_code( IStream, Icode ), now( Now ), http_transaction1( Now, Socket, IStream, Timeout, Response ), close( IStream ), tcp:tcp_shutdown( Socket, _Status ), Response \== timeout. http_transaction1( Now, Socket, IStream, Timeout, Response ) :- tcp:tcp_select( 0, Timeout, FD, Status ), http_transaction2( Status, Now, Socket, FD, IStream, Timeout, Response ). http_transaction2( 1, Then, Socket, FD, IStream, Timeout, Response ) :- ( Socket == FD -> stream_to_string( IStream, Response ) ; otherwise -> now( Now ), Elapsed is Now - Then, ( Elapsed < Timeout -> Timeout1 is Timeout - Elapsed, http_transaction1( Now, Socket, IStream, Timeout1, Response ) ; otherwise -> Response = timeout ) ). http_transaction2( 0, _Then, _Socket, _FD, _IStream, _Timeout, timeout ). http_transaction2( -1, _Then, Socket, _FD, IStream, Timeout, _Response ) :- raise_exception( socket_error(Socket, IStream, Timeout) ). getenvstr( Var, Chars ) :- environ( Var, Atom ), atom_chars( Atom, Chars ). :- use_module( library(environ), [environ/2] ). </pre> The ISO Prolog predicates used in PiLLoW can be mapped to equivalent Quintus built-in predicates. <pre class="prolog">flush_output :- ttyflush. atom_codes( Atom, Codes ) :- atom_chars( Atom, Codes ). catch( Goal, Error, Action ) :- on_exception( Error, Goal, Action ). get_code( Code ) :- get0( Code ). get_code( Stream, Code ) :- get0( Stream, Code ). include( File ) :- ensure_loaded( File ). number_codes( Number, Codes ) :- number_chars( Number, Codes ). put_code( Code ) :- put( Code ).</pre> Similarly, some library predicates are not defined/defined differently in Quintus: <pre class="prolog">atom_concat( A, B, AB ) :- name( A, AS ), name( B, BS ), append( AS, BS, ABS ), atom_chars( AB, ABS ). getenv( Var, QueryString ) :- environ( Var, QueryString ). :- use_module( library(environ), [environ/2] ).</pre> ==Pillow 1.0== I have ported PiLLoW 1.0 to use the [http://quintus.sics.se/ Quintus Prolog] 3.X libraries, and made it available as a [https://binding-time.co.uk/download/pillow.zip 260Kb Zip file]. It is offered here as free, '''unsupported''' source code, for which the author accepts no liability whatsoever. '''''Note:''''' The parsing of &quot;multipart&quot; form data on win32 can produce errors, when binary files are submitted, e.g. sending image files as part of the form input. This is because the default for &quot;stdin&quot; on win32 is &quot;text&quot;. bd4c8b4da1592f1485239ee78c0e6171b43e4c1b 197 177 2017-10-21T00:08:58Z John 2 /* Pillow 1.0 */ wikitext text/x-wiki == Porting PiLLoW to Quintus Prolog 3.X == The [http://cliplab.org/miscdocs/pillow/pillow.html PiLLoW] library provides predicates for developing HTTP client and server applications. For client applications, it provides mechanisms to retrieve HTML files and to parse HTML into useful Prolog terms. For server applications, it provides a predicate to access CGI query parameters, so that a Prolog application can be used to handle form input directly i.e. without additional scripting. Additionally, HTML parsing supports the reverse translation of terms into HTML, so that forms can be generated. ==PiLLoW 1.1== If you want to port [http://cliplab.org/miscdocs/pillow/pillow.html PiLLoW 1.1] to [http://quintus.sics.se/ Quintus Prolog], the following notes may be of use. ===http_transaction/5=== must be rewritten to use the Quintus tcp and socketio libraries. ====http_transaction(+Host, +Port, +Request, +Timeout, -Response)==== Sends an HTTP <var>Request</var> to an HTTP server <var>Host</var>:<var>Port</var> and returns the resulting message in <var>Response</var>. <var>Timeout</var> defines the maximum number of seconds to wait for a response. <pre class="prolog"> :- use_module(library(tcp)). :- use_module(library(socketio)). :- use_module(library(date), [now/1]). http_transaction( Host, Port, Request, Timeout, Response ) :- tcp:connect( Host, Port, Socket ), Socket >= 0, % Fail if connect error socket_io_open_output( Socket, Ocode ), stream_code( OStream, Ocode ), write_string( OStream, Request ), close( OStream ), socket_io_open_input( Socket, Icode ), stream_code( IStream, Icode ), now( Now ), http_transaction1( Now, Socket, IStream, Timeout, Response ), close( IStream ), tcp:tcp_shutdown( Socket, _Status ), Response \== timeout. http_transaction1( Now, Socket, IStream, Timeout, Response ) :- tcp:tcp_select( 0, Timeout, FD, Status ), http_transaction2( Status, Now, Socket, FD, IStream, Timeout, Response ). http_transaction2( 1, Then, Socket, FD, IStream, Timeout, Response ) :- ( Socket == FD -> stream_to_string( IStream, Response ) ; otherwise -> now( Now ), Elapsed is Now - Then, ( Elapsed < Timeout -> Timeout1 is Timeout - Elapsed, http_transaction1( Now, Socket, IStream, Timeout1, Response ) ; otherwise -> Response = timeout ) ). http_transaction2( 0, _Then, _Socket, _FD, _IStream, _Timeout, timeout ). http_transaction2( -1, _Then, Socket, _FD, IStream, Timeout, _Response ) :- raise_exception( socket_error(Socket, IStream, Timeout) ). getenvstr( Var, Chars ) :- environ( Var, Atom ), atom_chars( Atom, Chars ). :- use_module( library(environ), [environ/2] ). </pre> The ISO Prolog predicates used in PiLLoW can be mapped to equivalent Quintus built-in predicates. <pre class="prolog">flush_output :- ttyflush. atom_codes( Atom, Codes ) :- atom_chars( Atom, Codes ). catch( Goal, Error, Action ) :- on_exception( Error, Goal, Action ). get_code( Code ) :- get0( Code ). get_code( Stream, Code ) :- get0( Stream, Code ). include( File ) :- ensure_loaded( File ). number_codes( Number, Codes ) :- number_chars( Number, Codes ). put_code( Code ) :- put( Code ).</pre> Similarly, some library predicates are not defined/defined differently in Quintus: <pre class="prolog">atom_concat( A, B, AB ) :- name( A, AS ), name( B, BS ), append( AS, BS, ABS ), atom_chars( AB, ABS ). getenv( Var, QueryString ) :- environ( Var, QueryString ). :- use_module( library(environ), [environ/2] ).</pre> ==Pillow 1.0== I have ported PiLLoW 1.0 to use the [https://quintus.sics.se/ Quintus Prolog] 3.X libraries, and made it available as a [https://binding-time.co.uk/download/pillow.zip 260Kb Zip file]. It is offered here as free, '''unsupported''' source code, for which the author accepts no liability whatsoever. '''''Note:''''' The parsing of &quot;multipart&quot; form data on win32 can produce errors, when binary files are submitted, e.g. sending image files as part of the form input. This is because the default for &quot;stdin&quot; on win32 is &quot;text&quot;. 9c9d3326fc6736576babe396a4cd82156170594d 0 19 163 118 2016-05-22T00:33:19Z John 2 Updated PiLLoW link wikitext text/x-wiki __NOTOC__ == Prolog for the Worldwide Web == For a Prolog programmer, to suggest that Prolog is an ideal language for web-based applications is to invite the comment that, &ldquo;if you have only a hammer, everything looks like a nail&rdquo;. However, the correspondences between Prolog behaviour and HTTP, and Prolog data-structures and XML are so strong that it's fair to say that ''if Prolog is a hand, the Worldwide Web is a glove.'' == HTTP == Consider that Prolog's default behaviour is query-solving &ndash; where a query is posed for which arbitrarily many answers (solutions) may be returned. This can be mapped to HTTP's request/response mechanism straightforwardly: === HTTP GET === The HTTP GET verb has a clear correspondence with Prolog's notion of a query. In fact, Prolog can be used directly as part of a request URI, acting as a lightweight data structuring mechanism. However, HTTP requires each request/response to be deterministic, which suggests that ''all'' the solutions for a non-deterministic query should be returned. The solutions can be formatted as an XHTML list or table, for example. === Caching === Prolog programming allows for the 'caching' of expensive results using lemmas, a technique used in the solution of the [[Mister X#Lemmas|Mister X]] puzzle, for example. HTTP's 'HEAD' verb and GET with &ldquo;If-Modified-Since&rdquo; support caching mechanisms, primarily to save communications bandwidth. The integration of Prolog lemmas with HTTP's caching methods can save both bandwidth and recomputation through a single mechanism, enabling the creation of robust distributed applications with a minimum of fuss. === HTTP POST === When using Prolog with HTTP, the POST verb should be reserved for passing clauses from the client to the server, to update the server, not for queries. The fact that Prolog is a good format for including structured (composite) data items as part of a URI can obviate some inappropriate uses of HTTP's POST verb, by allowing more complex terms in GET requests. == XML == HTTP services in which both the client and server are Prolog programs can gain efficiency by exchanging Prolog terms in URIs and results, using Prolog's term I/O facilities. However, XML is becoming established as the preferred format for data exchange in heterogeneous distributed applications. XML data is represented easily in Prolog, and vice versa, because both use tree-structured data exclusively. Because Prolog is a very high-level language, it is more flexible and more powerful than [http://www.w3.org/TR/xslt XSLT]. In particular, it seems to be very much easier to create robust and reliable transformations with Prolog, i.e. ones that produce only valid output for any valid input. ===xml.pl=== xml.pl is a module for [[parsing XML with Prolog]]. It has been placed in the public domain to encourage the use of Prolog with XML. ==PiLLoW== The [http://cliplab.org/miscdocs/pillow/pillow.html PiLLoW] library provides predicates for developing HTTP client and server applications. For client applications, it provides mechanisms to retrieve HTML files and to parse HTML into useful Prolog terms. For server applications, it provides a predicate to access CGI query parameters so that a Prolog application can be used to handle form input directly i.e. without additional scripting. Additionally, HTML parsing supports the reverse translation of terms into HTML so that forms can be generated. See also, [[Porting PiLLoW to Quintus Prolog]]. f5263e4ba48ff6030cde4d84d47fc4bac83df7cc 198 163 2017-10-31T23:26:07Z John 2 Updating the XSLT link. wikitext text/x-wiki __NOTOC__ == Prolog for the Worldwide Web == For a Prolog programmer, to suggest that Prolog is an ideal language for web-based applications is to invite the comment that, &ldquo;if you have only a hammer, everything looks like a nail&rdquo;. However, the correspondences between Prolog behaviour and HTTP, and Prolog data-structures and XML are so strong that it's fair to say that ''if Prolog is a hand, the Worldwide Web is a glove.'' == HTTP == Consider that Prolog's default behaviour is query-solving &ndash; where a query is posed for which arbitrarily many answers (solutions) may be returned. This can be mapped to HTTP's request/response mechanism straightforwardly: === HTTP GET === The HTTP GET verb has a clear correspondence with Prolog's notion of a query. In fact, Prolog can be used directly as part of a request URI, acting as a lightweight data structuring mechanism. However, HTTP requires each request/response to be deterministic, which suggests that ''all'' the solutions for a non-deterministic query should be returned. The solutions can be formatted as an XHTML list or table, for example. === Caching === Prolog programming allows for the 'caching' of expensive results using lemmas, a technique used in the solution of the [[Mister X#Lemmas|Mister X]] puzzle, for example. HTTP's 'HEAD' verb and GET with &ldquo;If-Modified-Since&rdquo; support caching mechanisms, primarily to save communications bandwidth. The integration of Prolog lemmas with HTTP's caching methods can save both bandwidth and recomputation through a single mechanism, enabling the creation of robust distributed applications with a minimum of fuss. === HTTP POST === When using Prolog with HTTP, the POST verb should be reserved for passing clauses from the client to the server, to update the server, not for queries. The fact that Prolog is a good format for including structured (composite) data items as part of a URI can obviate some inappropriate uses of HTTP's POST verb, by allowing more complex terms in GET requests. == XML == HTTP services in which both the client and server are Prolog programs can gain efficiency by exchanging Prolog terms in URIs and results, using Prolog's term I/O facilities. However, XML is becoming established as the preferred format for data exchange in heterogeneous distributed applications. XML data is represented easily in Prolog, and vice versa, because both use tree-structured data exclusively. Because Prolog is a very high-level language, it is more flexible and more powerful than [https://www.w3.org/TR/xslt/ XSLT]. In particular, it seems to be very much easier to create robust and reliable transformations with Prolog, i.e. ones that produce only valid output for any valid input. ===xml.pl=== xml.pl is a module for [[parsing XML with Prolog]]. It has been placed in the public domain to encourage the use of Prolog with XML. ==PiLLoW== The [http://cliplab.org/miscdocs/pillow/pillow.html PiLLoW] library provides predicates for developing HTTP client and server applications. For client applications, it provides mechanisms to retrieve HTML files and to parse HTML into useful Prolog terms. For server applications, it provides a predicate to access CGI query parameters so that a Prolog application can be used to handle form input directly i.e. without additional scripting. Additionally, HTML parsing supports the reverse translation of terms into HTML so that forms can be generated. See also, [[Porting PiLLoW to Quintus Prolog]]. 1478312365a8e4164d82cfd788520cc97091f172 0 8 164 148 2016-06-03T19:39:37Z John 2 /* jug_transition( +State, +Capacities, ?Action, ?SuccessorState ) */ wikitext text/x-wiki __NOTOC__ This classic AI problem is described in ''Artificial Intelligence'' as follows: <blockquote> &ldquo;You are given two jugs, a 4-gallon one and a 3-gallon one. Neither has any measuring markers on it. There is a tap that can be used to fill the jugs with water. How can you get exactly 2 gallons of water into the 4-gallon jug?&rdquo;. <cite>[https://www.amazon.co.uk/Artificial-Intelligence-Elaine-Rich/dp/0070522634/276-9442056-6625664?tag=bindingtimeli-21 E. Rich & K. Knight, Artificial Intelligence, 2nd edition, McGraw-Hill, 1991]</cite> </blockquote> This program implements an &ldquo;environmentally responsible&rdquo; solution to the ''water jugs'' problem. Rather than filling and spilling from an infinite water resource, we conserve a finite initial charge with a third jug: (reservoir). This approach is simpler than the traditional method because there are only two actions. It is more flexible than the traditional method because it can solve problems that are constrained by a limited supply from the reservoir. To simulate the infinite version, we use a filled reservoir with a capacity greater than the combined capacities of the jugs so that the reservoir can never be emptied. <blockquote> &ldquo;Perfection is achieved not when there is nothing more to add, but when there is nothing more to take away.&rdquo; <cite>[https://en.wikiquote.org/wiki/Antoine_de_Saint_Exup%C3%A9ry Antoine de Saint-Exup&#233;ry]</cite> </blockquote> ==Solution== ====water_jugs==== is the entry point. The solution is derived by a simple, breadth-first, state-space search, and translated into a readable format by a DCG. <syntaxhighlight lang="prolog">water_jugs :- SmallCapacity = 3, LargeCapacity = 4, Reservoir is SmallCapacity + LargeCapacity + 1, volume( small, Capacities, SmallCapacity ), volume( large, Capacities, LargeCapacity ), volume( reservoir, Capacities, Reservoir ), volume( small, Start, 0 ), volume( large, Start, 0 ), volume( reservoir, Start, Reservoir ), volume( large, End, 2 ), water_jugs_solution( Start, Capacities, End, Solution ), phrase( narrative(Solution, Capacities, End), Chars ), put_chars( Chars ).</syntaxhighlight> ====water_jugs_solution( +Start, +Capacities, +End, ?Solution )==== holds when <var>Solution</var> is the terminal &lsquo;node&rsquo; in a state-space search - beginning with a &lsquo;start state&rsquo; in which the water-jugs have <var>Capacities</var> and contain the <var>Start</var> volumes. The terminal node is reached when the water-jugs contain the <var>End</var> volumes. <syntaxhighlight lang="prolog"> water_jugs_solution( Start, Capacities, End, Solution ) :- solve_jugs( [start(Start)], Capacities, [], End, Solution ). </syntaxhighlight> ====solve_jugs( +Nodes, +Capacities, +Visited, +End, ?Solution )==== holds when <var>Solution</var> is the terminal node in a state-space search, beginning with a first open node in <var>Nodes</var>, and terminating when the water-jugs contain the <var>End</var> volumes. <var>Capacities</var> define the capacities of the water-jugs while <var>Visited</var> is a list of expanded (closed) node states. The breadth-first operation of solve_jugs is due to the existing <var>Nodes</var> being appended to the new nodes. (If the new nodes were appended to the existing nodes, the operation would be depth-first.) <syntaxhighlight lang="prolog"> solve_jugs( [Node|Nodes], Capacities, Visited, End, Solution ) :- node_state( Node, State ), ( State = End -> Solution = Node ; otherwise -> findall( Successor, successor(Node, Capacities, Visited, Successor), Successors ), append( Nodes, Successors, NewNodes ), solve_jugs( NewNodes, Capacities, [State|Visited], End, Solution ) ). </syntaxhighlight> ====successor( +Node, +Capacities, +Visited, ?Successor )==== <var>Successor</var> is a successor of <var>Node</var>, for water-jugs with <var>Capacities</var>, if there is a legal transition from <var>Node</var>'s state to <var>Successor</var>'s state, and <var>Successor</var>'s state is not a member of the <var>Visited</var> states. <syntaxhighlight lang="prolog"> successor( Node, Capacities, Visited, Successor ) :- node_state( Node, State ), Successor = node(Action,State1,Node), jug_transition( State, Capacities, Action, State1 ), \+ member( State1, Visited ). </syntaxhighlight> ===Transition Rules=== ====jug_transition( +State, +Capacities, ?Action, ?SuccessorState )==== holds when <var>Action</var> describes a valid transition, from <var>State</var> to <var>SuccessorState</var>, for water-jugs with <var>Capacities</var>. There are two sorts of <var>Action</var>: * <code>empty_into(Source,Target)</code> valid if ''Source'' is not already empty and the combined contents from ''Source'' and ''Target'', in <var>State</var>, are not greater than the capacity of the ''Target'' jug. The ''Source'' jug becomes empty in <var>SuccessorState</var> while the ''Target'' jug acquires the combined contents of ''Source'' and ''Target'' in <var>State</var>. * <code>fill_from(Source,Target)</code> valid if ''Source'' is not already empty, and the combined contents from ''Source'' and ''Target'', in <var>State</var>, are greater than the capacity of the ''Target'' jug. The ''Target'' jug becomes full in <var>SuccessorState</var>, while ''Source'' retains the excess of the combined contents of ''Source'' and ''Target'' in <var>State</var>, over the capacity of the ''Target'' jug. In either case, the contents of the unused jug are unchanged. <syntaxhighlight lang="prolog">jug_transition( State0, Capacities, Action, State1 ) :- volume( Source, State0, SourceContents ), SourceContents > 0, jug_permutation( Source, Target, Unused ), volume( Target, State0, TargetContents ), volume( Target, Capacities, TargetCapacity ), volume( Unused, State0, Unchanged ), volume( Unused, State1, Unchanged ), CombinedContents is SourceContents + TargetContents, ( CombinedContents =< TargetCapacity -> Action = empty_into(Source,Target), NewSourceContents = 0, NewTargetContents = CombinedContents ; CombinedContents > TargetCapacity -> Action = fill_from(Source,Target), NewSourceContents is CombinedContents-TargetCapacity, NewTargetContents = TargetCapacity ), volume( Source, State1, NewSourceContents ), volume( Target, State1, NewTargetContents ).</syntaxhighlight> ==Data Abstraction== ====volume( ?Jug, ?State, ?Volume )==== holds when <var>Jug</var> (large, small or reservoir) has <var>Volume</var> in <var>State</var>. <syntaxhighlight lang="prolog"> volume( small, jugs(Small, _Large, _Reservoir), Small ). volume( large, jugs(_Small, Large, _Reservoir), Large ). volume( reservoir, jugs(_Small, _Large, Reservoir), Reservoir ). </syntaxhighlight> ====jug_permutation( ?Source, ?Target, ?Unused )==== holds when <var>Source</var>, <var>Target</var> and <var>Unused</var> are a permutation of <code>small</code>, <code>large</code> and <code>reservoir</code>. <syntaxhighlight lang="prolog"> jug_permutation( Source, Target, Unused ) :- select( Source, [small, large, reservoir], Residue ), select( Target, Residue, [Unused] ). </syntaxhighlight> ====node_state( ?Node, ?State )==== holds when the contents of the water-jugs at <var>Node</var> are described by <var>State</var>. <syntaxhighlight lang="prolog"> node_state( start(State), State ). node_state( node(_Transition, State, _Predecessor), State ). </syntaxhighlight> ==Definite Clause Grammar== ====narrative( +Solution, +Capacities, +End )/==== is a DCG presenting the water-jugs <var>Solution</var> in a readable format. The grammar is head-recursive because the <var>Solution</var> has the last node outermost. <syntaxhighlight lang="prolog"> narrative( start(Start), Capacities, End ) --> "Given three jugs with capacities of:", newline, literal_volumes( Capacities ), "To obtain the result:", newline, literal_volumes( End ), "Starting with:", newline, literal_volumes( Start ), "Do the following:", newline. narrative( node(Transition, Result, Predecessor), Capacities, End ) --> narrative( Predecessor, Capacities, End ), literal_action( Transition, Result ). literal_volumes( Volumes ) --> indent, literal( Volumes ), ";", newline. literal_action( Transition, Result ) --> indent, "- ", literal( Transition ), " giving:", newline, indent, indent, literal( Result ), newline. literal( empty_into(From,To) ) --> "Empty the ", literal( From ), " into the ", literal( To ). literal( fill_from(From,To) ) --> "Fill the ", literal( To ), " from the ", literal( From ). literal( jugs(Small,Large,Reservoir) ) --> literal_number( Small ), " gallons in the small jug, ", literal_number( Large ), " gallons in the large jug and ", literal_number( Reservoir ), " gallons in the reservoir". literal( small ) --> "small jug". literal( large ) --> "large jug". literal( reservoir ) --> "reservoir". literal_number( Number, Plus, Minus ) :- number( Number ), number_chars( Number, Chars ), append( Chars, Minus, Plus ). indent --> " ". newline --> " ". </syntaxhighlight> ==Utility Predicates== Load a small library of [[Puzzle Utilities]]. <syntaxhighlight lang="prolog"> :- ensure_loaded( misc ). </syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/download/water_jugs.txt here]. ==Output== The output of the program is: <div class="result"> <pre> ?- water_jugs. Given three jugs with capacities of: 3 gallons in the small jug, 4 gallons in the large jug and 8 gallons in the reservoir; To obtain the result: 0 gallons in the small jug, 2 gallons in the large jug and 6 gallons in the reservoir; Starting with: 0 gallons in the small jug, 0 gallons in the large jug and 8 gallons in the reservoir; Do the following: - Fill the small jug from the reservoir giving: 3 gallons in the small jug, 0 gallons in the large jug and 5 gallons in the reservoir - Empty the small jug into the large jug giving: 0 gallons in the small jug, 3 gallons in the large jug and 5 gallons in the reservoir - Fill the small jug from the reservoir giving: 3 gallons in the small jug, 3 gallons in the large jug and 2 gallons in the reservoir - Fill the large jug from the small jug giving: 2 gallons in the small jug, 4 gallons in the large jug and 2 gallons in the reservoir - Empty the large jug into the reservoir giving: 2 gallons in the small jug, 0 gallons in the large jug and 6 gallons in the reservoir - Empty the small jug into the large jug giving: 0 gallons in the small jug, 2 gallons in the large jug and 6 gallons in the reservoir yes </pre> </div> e92f14ed44dd5b1335eb2a3099e9e403dfa52e63 165 164 2016-11-18T18:36:45Z John 2 /* water_jugs_solution( +Start, +Capacities, +End, ?Solution ) */ wikitext text/x-wiki __NOTOC__ This classic AI problem is described in ''Artificial Intelligence'' as follows: <blockquote> &ldquo;You are given two jugs, a 4-gallon one and a 3-gallon one. Neither has any measuring markers on it. There is a tap that can be used to fill the jugs with water. How can you get exactly 2 gallons of water into the 4-gallon jug?&rdquo;. <cite>[https://www.amazon.co.uk/Artificial-Intelligence-Elaine-Rich/dp/0070522634/276-9442056-6625664?tag=bindingtimeli-21 E. Rich & K. Knight, Artificial Intelligence, 2nd edition, McGraw-Hill, 1991]</cite> </blockquote> This program implements an &ldquo;environmentally responsible&rdquo; solution to the ''water jugs'' problem. Rather than filling and spilling from an infinite water resource, we conserve a finite initial charge with a third jug: (reservoir). This approach is simpler than the traditional method because there are only two actions. It is more flexible than the traditional method because it can solve problems that are constrained by a limited supply from the reservoir. To simulate the infinite version, we use a filled reservoir with a capacity greater than the combined capacities of the jugs so that the reservoir can never be emptied. <blockquote> &ldquo;Perfection is achieved not when there is nothing more to add, but when there is nothing more to take away.&rdquo; <cite>[https://en.wikiquote.org/wiki/Antoine_de_Saint_Exup%C3%A9ry Antoine de Saint-Exup&#233;ry]</cite> </blockquote> ==Solution== ====water_jugs==== is the entry point. The solution is derived by a simple, breadth-first, state-space search, and translated into a readable format by a DCG. <syntaxhighlight lang="prolog">water_jugs :- SmallCapacity = 3, LargeCapacity = 4, Reservoir is SmallCapacity + LargeCapacity + 1, volume( small, Capacities, SmallCapacity ), volume( large, Capacities, LargeCapacity ), volume( reservoir, Capacities, Reservoir ), volume( small, Start, 0 ), volume( large, Start, 0 ), volume( reservoir, Start, Reservoir ), volume( large, End, 2 ), water_jugs_solution( Start, Capacities, End, Solution ), phrase( narrative(Solution, Capacities, End), Chars ), put_chars( Chars ).</syntaxhighlight> ====water_jugs_solution( +Start, +Capacities, +End, ?Solution )==== holds when <var>Solution</var> is the terminal state in a state-space search that begins with an initial state, in which the water-jugs have <var>Capacities</var> and contain the <var>Start</var> volumes, and ends when the water-jugs contain the <var>End</var> volumes. <syntaxhighlight lang="prolog"> water_jugs_solution( Start, Capacities, End, Solution ) :- solve_jugs( [start(Start)], Capacities, [], End, Solution ). </syntaxhighlight> ====solve_jugs( +Nodes, +Capacities, +Visited, +End, ?Solution )==== holds when <var>Solution</var> is the terminal node in a state-space search, beginning with a first open node in <var>Nodes</var>, and terminating when the water-jugs contain the <var>End</var> volumes. <var>Capacities</var> define the capacities of the water-jugs while <var>Visited</var> is a list of expanded (closed) node states. The breadth-first operation of solve_jugs is due to the existing <var>Nodes</var> being appended to the new nodes. (If the new nodes were appended to the existing nodes, the operation would be depth-first.) <syntaxhighlight lang="prolog"> solve_jugs( [Node|Nodes], Capacities, Visited, End, Solution ) :- node_state( Node, State ), ( State = End -> Solution = Node ; otherwise -> findall( Successor, successor(Node, Capacities, Visited, Successor), Successors ), append( Nodes, Successors, NewNodes ), solve_jugs( NewNodes, Capacities, [State|Visited], End, Solution ) ). </syntaxhighlight> ====successor( +Node, +Capacities, +Visited, ?Successor )==== <var>Successor</var> is a successor of <var>Node</var>, for water-jugs with <var>Capacities</var>, if there is a legal transition from <var>Node</var>'s state to <var>Successor</var>'s state, and <var>Successor</var>'s state is not a member of the <var>Visited</var> states. <syntaxhighlight lang="prolog"> successor( Node, Capacities, Visited, Successor ) :- node_state( Node, State ), Successor = node(Action,State1,Node), jug_transition( State, Capacities, Action, State1 ), \+ member( State1, Visited ). </syntaxhighlight> ===Transition Rules=== ====jug_transition( +State, +Capacities, ?Action, ?SuccessorState )==== holds when <var>Action</var> describes a valid transition, from <var>State</var> to <var>SuccessorState</var>, for water-jugs with <var>Capacities</var>. There are two sorts of <var>Action</var>: * <code>empty_into(Source,Target)</code> valid if ''Source'' is not already empty and the combined contents from ''Source'' and ''Target'', in <var>State</var>, are not greater than the capacity of the ''Target'' jug. The ''Source'' jug becomes empty in <var>SuccessorState</var> while the ''Target'' jug acquires the combined contents of ''Source'' and ''Target'' in <var>State</var>. * <code>fill_from(Source,Target)</code> valid if ''Source'' is not already empty, and the combined contents from ''Source'' and ''Target'', in <var>State</var>, are greater than the capacity of the ''Target'' jug. The ''Target'' jug becomes full in <var>SuccessorState</var>, while ''Source'' retains the excess of the combined contents of ''Source'' and ''Target'' in <var>State</var>, over the capacity of the ''Target'' jug. In either case, the contents of the unused jug are unchanged. <syntaxhighlight lang="prolog">jug_transition( State0, Capacities, Action, State1 ) :- volume( Source, State0, SourceContents ), SourceContents > 0, jug_permutation( Source, Target, Unused ), volume( Target, State0, TargetContents ), volume( Target, Capacities, TargetCapacity ), volume( Unused, State0, Unchanged ), volume( Unused, State1, Unchanged ), CombinedContents is SourceContents + TargetContents, ( CombinedContents =< TargetCapacity -> Action = empty_into(Source,Target), NewSourceContents = 0, NewTargetContents = CombinedContents ; CombinedContents > TargetCapacity -> Action = fill_from(Source,Target), NewSourceContents is CombinedContents-TargetCapacity, NewTargetContents = TargetCapacity ), volume( Source, State1, NewSourceContents ), volume( Target, State1, NewTargetContents ).</syntaxhighlight> ==Data Abstraction== ====volume( ?Jug, ?State, ?Volume )==== holds when <var>Jug</var> (large, small or reservoir) has <var>Volume</var> in <var>State</var>. <syntaxhighlight lang="prolog"> volume( small, jugs(Small, _Large, _Reservoir), Small ). volume( large, jugs(_Small, Large, _Reservoir), Large ). volume( reservoir, jugs(_Small, _Large, Reservoir), Reservoir ). </syntaxhighlight> ====jug_permutation( ?Source, ?Target, ?Unused )==== holds when <var>Source</var>, <var>Target</var> and <var>Unused</var> are a permutation of <code>small</code>, <code>large</code> and <code>reservoir</code>. <syntaxhighlight lang="prolog"> jug_permutation( Source, Target, Unused ) :- select( Source, [small, large, reservoir], Residue ), select( Target, Residue, [Unused] ). </syntaxhighlight> ====node_state( ?Node, ?State )==== holds when the contents of the water-jugs at <var>Node</var> are described by <var>State</var>. <syntaxhighlight lang="prolog"> node_state( start(State), State ). node_state( node(_Transition, State, _Predecessor), State ). </syntaxhighlight> ==Definite Clause Grammar== ====narrative( +Solution, +Capacities, +End )/==== is a DCG presenting the water-jugs <var>Solution</var> in a readable format. The grammar is head-recursive because the <var>Solution</var> has the last node outermost. <syntaxhighlight lang="prolog"> narrative( start(Start), Capacities, End ) --> "Given three jugs with capacities of:", newline, literal_volumes( Capacities ), "To obtain the result:", newline, literal_volumes( End ), "Starting with:", newline, literal_volumes( Start ), "Do the following:", newline. narrative( node(Transition, Result, Predecessor), Capacities, End ) --> narrative( Predecessor, Capacities, End ), literal_action( Transition, Result ). literal_volumes( Volumes ) --> indent, literal( Volumes ), ";", newline. literal_action( Transition, Result ) --> indent, "- ", literal( Transition ), " giving:", newline, indent, indent, literal( Result ), newline. literal( empty_into(From,To) ) --> "Empty the ", literal( From ), " into the ", literal( To ). literal( fill_from(From,To) ) --> "Fill the ", literal( To ), " from the ", literal( From ). literal( jugs(Small,Large,Reservoir) ) --> literal_number( Small ), " gallons in the small jug, ", literal_number( Large ), " gallons in the large jug and ", literal_number( Reservoir ), " gallons in the reservoir". literal( small ) --> "small jug". literal( large ) --> "large jug". literal( reservoir ) --> "reservoir". literal_number( Number, Plus, Minus ) :- number( Number ), number_chars( Number, Chars ), append( Chars, Minus, Plus ). indent --> " ". newline --> " ". </syntaxhighlight> ==Utility Predicates== Load a small library of [[Puzzle Utilities]]. <syntaxhighlight lang="prolog"> :- ensure_loaded( misc ). </syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/download/water_jugs.txt here]. ==Output== The output of the program is: <div class="result"> <pre> ?- water_jugs. Given three jugs with capacities of: 3 gallons in the small jug, 4 gallons in the large jug and 8 gallons in the reservoir; To obtain the result: 0 gallons in the small jug, 2 gallons in the large jug and 6 gallons in the reservoir; Starting with: 0 gallons in the small jug, 0 gallons in the large jug and 8 gallons in the reservoir; Do the following: - Fill the small jug from the reservoir giving: 3 gallons in the small jug, 0 gallons in the large jug and 5 gallons in the reservoir - Empty the small jug into the large jug giving: 0 gallons in the small jug, 3 gallons in the large jug and 5 gallons in the reservoir - Fill the small jug from the reservoir giving: 3 gallons in the small jug, 3 gallons in the large jug and 2 gallons in the reservoir - Fill the large jug from the small jug giving: 2 gallons in the small jug, 4 gallons in the large jug and 2 gallons in the reservoir - Empty the large jug into the reservoir giving: 2 gallons in the small jug, 0 gallons in the large jug and 6 gallons in the reservoir - Empty the small jug into the large jug giving: 0 gallons in the small jug, 2 gallons in the large jug and 6 gallons in the reservoir yes </pre> </div> a49b64a70037e6285e1a472dfda07e8f471cdaa4 166 165 2016-11-18T18:38:23Z John 2 /* successor( +Node, +Capacities, +Visited, ?Successor ) */ wikitext text/x-wiki __NOTOC__ This classic AI problem is described in ''Artificial Intelligence'' as follows: <blockquote> &ldquo;You are given two jugs, a 4-gallon one and a 3-gallon one. Neither has any measuring markers on it. There is a tap that can be used to fill the jugs with water. How can you get exactly 2 gallons of water into the 4-gallon jug?&rdquo;. <cite>[https://www.amazon.co.uk/Artificial-Intelligence-Elaine-Rich/dp/0070522634/276-9442056-6625664?tag=bindingtimeli-21 E. Rich & K. Knight, Artificial Intelligence, 2nd edition, McGraw-Hill, 1991]</cite> </blockquote> This program implements an &ldquo;environmentally responsible&rdquo; solution to the ''water jugs'' problem. Rather than filling and spilling from an infinite water resource, we conserve a finite initial charge with a third jug: (reservoir). This approach is simpler than the traditional method because there are only two actions. It is more flexible than the traditional method because it can solve problems that are constrained by a limited supply from the reservoir. To simulate the infinite version, we use a filled reservoir with a capacity greater than the combined capacities of the jugs so that the reservoir can never be emptied. <blockquote> &ldquo;Perfection is achieved not when there is nothing more to add, but when there is nothing more to take away.&rdquo; <cite>[https://en.wikiquote.org/wiki/Antoine_de_Saint_Exup%C3%A9ry Antoine de Saint-Exup&#233;ry]</cite> </blockquote> ==Solution== ====water_jugs==== is the entry point. The solution is derived by a simple, breadth-first, state-space search, and translated into a readable format by a DCG. <syntaxhighlight lang="prolog">water_jugs :- SmallCapacity = 3, LargeCapacity = 4, Reservoir is SmallCapacity + LargeCapacity + 1, volume( small, Capacities, SmallCapacity ), volume( large, Capacities, LargeCapacity ), volume( reservoir, Capacities, Reservoir ), volume( small, Start, 0 ), volume( large, Start, 0 ), volume( reservoir, Start, Reservoir ), volume( large, End, 2 ), water_jugs_solution( Start, Capacities, End, Solution ), phrase( narrative(Solution, Capacities, End), Chars ), put_chars( Chars ).</syntaxhighlight> ====water_jugs_solution( +Start, +Capacities, +End, ?Solution )==== holds when <var>Solution</var> is the terminal state in a state-space search that begins with an initial state, in which the water-jugs have <var>Capacities</var> and contain the <var>Start</var> volumes, and ends when the water-jugs contain the <var>End</var> volumes. <syntaxhighlight lang="prolog"> water_jugs_solution( Start, Capacities, End, Solution ) :- solve_jugs( [start(Start)], Capacities, [], End, Solution ). </syntaxhighlight> ====solve_jugs( +Nodes, +Capacities, +Visited, +End, ?Solution )==== holds when <var>Solution</var> is the terminal node in a state-space search, beginning with a first open node in <var>Nodes</var>, and terminating when the water-jugs contain the <var>End</var> volumes. <var>Capacities</var> define the capacities of the water-jugs while <var>Visited</var> is a list of expanded (closed) node states. The breadth-first operation of solve_jugs is due to the existing <var>Nodes</var> being appended to the new nodes. (If the new nodes were appended to the existing nodes, the operation would be depth-first.) <syntaxhighlight lang="prolog"> solve_jugs( [Node|Nodes], Capacities, Visited, End, Solution ) :- node_state( Node, State ), ( State = End -> Solution = Node ; otherwise -> findall( Successor, successor(Node, Capacities, Visited, Successor), Successors ), append( Nodes, Successors, NewNodes ), solve_jugs( NewNodes, Capacities, [State|Visited], End, Solution ) ). </syntaxhighlight> ====successor( +Node, +Capacities, +Visited, ?Successor )==== <var>Successor</var> is a successor of <var>Node</var>, for water-jugs with <var>Capacities</var>, if there is a legal transition from <var>Node</var>'s state to <var>Successor</var>'s state and <var>Successor</var>'s state is not a member of the <var>Visited</var> states. <syntaxhighlight lang="prolog"> successor( Node, Capacities, Visited, Successor ) :- node_state( Node, State ), Successor = node(Action,State1,Node), jug_transition( State, Capacities, Action, State1 ), \+ member( State1, Visited ). </syntaxhighlight> ===Transition Rules=== ====jug_transition( +State, +Capacities, ?Action, ?SuccessorState )==== holds when <var>Action</var> describes a valid transition, from <var>State</var> to <var>SuccessorState</var>, for water-jugs with <var>Capacities</var>. There are two sorts of <var>Action</var>: * <code>empty_into(Source,Target)</code> valid if ''Source'' is not already empty and the combined contents from ''Source'' and ''Target'', in <var>State</var>, are not greater than the capacity of the ''Target'' jug. The ''Source'' jug becomes empty in <var>SuccessorState</var> while the ''Target'' jug acquires the combined contents of ''Source'' and ''Target'' in <var>State</var>. * <code>fill_from(Source,Target)</code> valid if ''Source'' is not already empty, and the combined contents from ''Source'' and ''Target'', in <var>State</var>, are greater than the capacity of the ''Target'' jug. The ''Target'' jug becomes full in <var>SuccessorState</var>, while ''Source'' retains the excess of the combined contents of ''Source'' and ''Target'' in <var>State</var>, over the capacity of the ''Target'' jug. In either case, the contents of the unused jug are unchanged. <syntaxhighlight lang="prolog">jug_transition( State0, Capacities, Action, State1 ) :- volume( Source, State0, SourceContents ), SourceContents > 0, jug_permutation( Source, Target, Unused ), volume( Target, State0, TargetContents ), volume( Target, Capacities, TargetCapacity ), volume( Unused, State0, Unchanged ), volume( Unused, State1, Unchanged ), CombinedContents is SourceContents + TargetContents, ( CombinedContents =< TargetCapacity -> Action = empty_into(Source,Target), NewSourceContents = 0, NewTargetContents = CombinedContents ; CombinedContents > TargetCapacity -> Action = fill_from(Source,Target), NewSourceContents is CombinedContents-TargetCapacity, NewTargetContents = TargetCapacity ), volume( Source, State1, NewSourceContents ), volume( Target, State1, NewTargetContents ).</syntaxhighlight> ==Data Abstraction== ====volume( ?Jug, ?State, ?Volume )==== holds when <var>Jug</var> (large, small or reservoir) has <var>Volume</var> in <var>State</var>. <syntaxhighlight lang="prolog"> volume( small, jugs(Small, _Large, _Reservoir), Small ). volume( large, jugs(_Small, Large, _Reservoir), Large ). volume( reservoir, jugs(_Small, _Large, Reservoir), Reservoir ). </syntaxhighlight> ====jug_permutation( ?Source, ?Target, ?Unused )==== holds when <var>Source</var>, <var>Target</var> and <var>Unused</var> are a permutation of <code>small</code>, <code>large</code> and <code>reservoir</code>. <syntaxhighlight lang="prolog"> jug_permutation( Source, Target, Unused ) :- select( Source, [small, large, reservoir], Residue ), select( Target, Residue, [Unused] ). </syntaxhighlight> ====node_state( ?Node, ?State )==== holds when the contents of the water-jugs at <var>Node</var> are described by <var>State</var>. <syntaxhighlight lang="prolog"> node_state( start(State), State ). node_state( node(_Transition, State, _Predecessor), State ). </syntaxhighlight> ==Definite Clause Grammar== ====narrative( +Solution, +Capacities, +End )/==== is a DCG presenting the water-jugs <var>Solution</var> in a readable format. The grammar is head-recursive because the <var>Solution</var> has the last node outermost. <syntaxhighlight lang="prolog"> narrative( start(Start), Capacities, End ) --> "Given three jugs with capacities of:", newline, literal_volumes( Capacities ), "To obtain the result:", newline, literal_volumes( End ), "Starting with:", newline, literal_volumes( Start ), "Do the following:", newline. narrative( node(Transition, Result, Predecessor), Capacities, End ) --> narrative( Predecessor, Capacities, End ), literal_action( Transition, Result ). literal_volumes( Volumes ) --> indent, literal( Volumes ), ";", newline. literal_action( Transition, Result ) --> indent, "- ", literal( Transition ), " giving:", newline, indent, indent, literal( Result ), newline. literal( empty_into(From,To) ) --> "Empty the ", literal( From ), " into the ", literal( To ). literal( fill_from(From,To) ) --> "Fill the ", literal( To ), " from the ", literal( From ). literal( jugs(Small,Large,Reservoir) ) --> literal_number( Small ), " gallons in the small jug, ", literal_number( Large ), " gallons in the large jug and ", literal_number( Reservoir ), " gallons in the reservoir". literal( small ) --> "small jug". literal( large ) --> "large jug". literal( reservoir ) --> "reservoir". literal_number( Number, Plus, Minus ) :- number( Number ), number_chars( Number, Chars ), append( Chars, Minus, Plus ). indent --> " ". newline --> " ". </syntaxhighlight> ==Utility Predicates== Load a small library of [[Puzzle Utilities]]. <syntaxhighlight lang="prolog"> :- ensure_loaded( misc ). </syntaxhighlight> The code is available as plain text [https://binding-time.co.uk/download/water_jugs.txt here]. ==Output== The output of the program is: <div class="result"> <pre> ?- water_jugs. Given three jugs with capacities of: 3 gallons in the small jug, 4 gallons in the large jug and 8 gallons in the reservoir; To obtain the result: 0 gallons in the small jug, 2 gallons in the large jug and 6 gallons in the reservoir; Starting with: 0 gallons in the small jug, 0 gallons in the large jug and 8 gallons in the reservoir; Do the following: - Fill the small jug from the reservoir giving: 3 gallons in the small jug, 0 gallons in the large jug and 5 gallons in the reservoir - Empty the small jug into the large jug giving: 0 gallons in the small jug, 3 gallons in the large jug and 5 gallons in the reservoir - Fill the small jug from the reservoir giving: 3 gallons in the small jug, 3 gallons in the large jug and 2 gallons in the reservoir - Fill the large jug from the small jug giving: 2 gallons in the small jug, 4 gallons in the large jug and 2 gallons in the reservoir - Empty the large jug into the reservoir giving: 2 gallons in the small jug, 0 gallons in the large jug and 6 gallons in the reservoir - Empty the small jug into the large jug giving: 0 gallons in the small jug, 2 gallons in the large jug and 6 gallons in the reservoir yes </pre> </div> 5334adddf75f35cd6379ecb159d9393ed12e7baa 169 166 2017-01-05T20:20:32Z John 2 Remove broken syntax highlighting wikitext text/x-wiki __NOTOC__ This classic AI problem is described in ''Artificial Intelligence'' as follows: <blockquote> &ldquo;You are given two jugs, a 4-gallon one and a 3-gallon one. Neither has any measuring markers on it. There is a tap that can be used to fill the jugs with water. How can you get exactly 2 gallons of water into the 4-gallon jug?&rdquo;. <cite>[https://www.amazon.co.uk/Artificial-Intelligence-Elaine-Rich/dp/0070522634/276-9442056-6625664?tag=bindingtimeli-21 E. Rich & K. Knight, Artificial Intelligence, 2nd edition, McGraw-Hill, 1991]</cite> </blockquote> This program implements an &ldquo;environmentally responsible&rdquo; solution to the ''water jugs'' problem. Rather than filling and spilling from an infinite water resource, we conserve a finite initial charge with a third jug: (reservoir). This approach is simpler than the traditional method because there are only two actions. It is more flexible than the traditional method because it can solve problems that are constrained by a limited supply from the reservoir. To simulate the infinite version, we use a filled reservoir with a capacity greater than the combined capacities of the jugs so that the reservoir can never be emptied. <blockquote> &ldquo;Perfection is achieved not when there is nothing more to add, but when there is nothing more to take away.&rdquo; <cite>[https://en.wikiquote.org/wiki/Antoine_de_Saint_Exup%C3%A9ry Antoine de Saint-Exup&#233;ry]</cite> </blockquote> ==Solution== ====water_jugs==== is the entry point. The solution is derived by a simple, breadth-first, state-space search, and translated into a readable format by a DCG. <pre class="prolog">water_jugs :- SmallCapacity = 3, LargeCapacity = 4, Reservoir is SmallCapacity + LargeCapacity + 1, volume( small, Capacities, SmallCapacity ), volume( large, Capacities, LargeCapacity ), volume( reservoir, Capacities, Reservoir ), volume( small, Start, 0 ), volume( large, Start, 0 ), volume( reservoir, Start, Reservoir ), volume( large, End, 2 ), water_jugs_solution( Start, Capacities, End, Solution ), phrase( narrative(Solution, Capacities, End), Chars ), put_chars( Chars ).</pre> ====water_jugs_solution( +Start, +Capacities, +End, ?Solution )==== holds when <var>Solution</var> is the terminal state in a state-space search that begins with an initial state, in which the water-jugs have <var>Capacities</var> and contain the <var>Start</var> volumes, and ends when the water-jugs contain the <var>End</var> volumes. <pre class="prolog"> water_jugs_solution( Start, Capacities, End, Solution ) :- solve_jugs( [start(Start)], Capacities, [], End, Solution ). </pre> ====solve_jugs( +Nodes, +Capacities, +Visited, +End, ?Solution )==== holds when <var>Solution</var> is the terminal node in a state-space search, beginning with a first open node in <var>Nodes</var>, and terminating when the water-jugs contain the <var>End</var> volumes. <var>Capacities</var> define the capacities of the water-jugs while <var>Visited</var> is a list of expanded (closed) node states. The breadth-first operation of solve_jugs is due to the existing <var>Nodes</var> being appended to the new nodes. (If the new nodes were appended to the existing nodes, the operation would be depth-first.) <pre class="prolog"> solve_jugs( [Node|Nodes], Capacities, Visited, End, Solution ) :- node_state( Node, State ), ( State = End -> Solution = Node ; otherwise -> findall( Successor, successor(Node, Capacities, Visited, Successor), Successors ), append( Nodes, Successors, NewNodes ), solve_jugs( NewNodes, Capacities, [State|Visited], End, Solution ) ). </pre> ====successor( +Node, +Capacities, +Visited, ?Successor )==== <var>Successor</var> is a successor of <var>Node</var>, for water-jugs with <var>Capacities</var>, if there is a legal transition from <var>Node</var>'s state to <var>Successor</var>'s state and <var>Successor</var>'s state is not a member of the <var>Visited</var> states. <pre class="prolog"> successor( Node, Capacities, Visited, Successor ) :- node_state( Node, State ), Successor = node(Action,State1,Node), jug_transition( State, Capacities, Action, State1 ), \+ member( State1, Visited ). </pre> ===Transition Rules=== ====jug_transition( +State, +Capacities, ?Action, ?SuccessorState )==== holds when <var>Action</var> describes a valid transition, from <var>State</var> to <var>SuccessorState</var>, for water-jugs with <var>Capacities</var>. There are two sorts of <var>Action</var>: * <code>empty_into(Source,Target)</code> valid if ''Source'' is not already empty and the combined contents from ''Source'' and ''Target'', in <var>State</var>, are not greater than the capacity of the ''Target'' jug. The ''Source'' jug becomes empty in <var>SuccessorState</var> while the ''Target'' jug acquires the combined contents of ''Source'' and ''Target'' in <var>State</var>. * <code>fill_from(Source,Target)</code> valid if ''Source'' is not already empty, and the combined contents from ''Source'' and ''Target'', in <var>State</var>, are greater than the capacity of the ''Target'' jug. The ''Target'' jug becomes full in <var>SuccessorState</var>, while ''Source'' retains the excess of the combined contents of ''Source'' and ''Target'' in <var>State</var>, over the capacity of the ''Target'' jug. In either case, the contents of the unused jug are unchanged. <pre class="prolog">jug_transition( State0, Capacities, Action, State1 ) :- volume( Source, State0, SourceContents ), SourceContents > 0, jug_permutation( Source, Target, Unused ), volume( Target, State0, TargetContents ), volume( Target, Capacities, TargetCapacity ), volume( Unused, State0, Unchanged ), volume( Unused, State1, Unchanged ), CombinedContents is SourceContents + TargetContents, ( CombinedContents =< TargetCapacity -> Action = empty_into(Source,Target), NewSourceContents = 0, NewTargetContents = CombinedContents ; CombinedContents > TargetCapacity -> Action = fill_from(Source,Target), NewSourceContents is CombinedContents-TargetCapacity, NewTargetContents = TargetCapacity ), volume( Source, State1, NewSourceContents ), volume( Target, State1, NewTargetContents ).</pre> ==Data Abstraction== ====volume( ?Jug, ?State, ?Volume )==== holds when <var>Jug</var> (large, small or reservoir) has <var>Volume</var> in <var>State</var>. <pre class="prolog"> volume( small, jugs(Small, _Large, _Reservoir), Small ). volume( large, jugs(_Small, Large, _Reservoir), Large ). volume( reservoir, jugs(_Small, _Large, Reservoir), Reservoir ). </pre> ====jug_permutation( ?Source, ?Target, ?Unused )==== holds when <var>Source</var>, <var>Target</var> and <var>Unused</var> are a permutation of <code>small</code>, <code>large</code> and <code>reservoir</code>. <pre class="prolog"> jug_permutation( Source, Target, Unused ) :- select( Source, [small, large, reservoir], Residue ), select( Target, Residue, [Unused] ). </pre> ====node_state( ?Node, ?State )==== holds when the contents of the water-jugs at <var>Node</var> are described by <var>State</var>. <pre class="prolog"> node_state( start(State), State ). node_state( node(_Transition, State, _Predecessor), State ). </pre> ==Definite Clause Grammar== ====narrative( +Solution, +Capacities, +End )/==== is a DCG presenting the water-jugs <var>Solution</var> in a readable format. The grammar is head-recursive because the <var>Solution</var> has the last node outermost. <pre class="prolog"> narrative( start(Start), Capacities, End ) --> "Given three jugs with capacities of:", newline, literal_volumes( Capacities ), "To obtain the result:", newline, literal_volumes( End ), "Starting with:", newline, literal_volumes( Start ), "Do the following:", newline. narrative( node(Transition, Result, Predecessor), Capacities, End ) --> narrative( Predecessor, Capacities, End ), literal_action( Transition, Result ). literal_volumes( Volumes ) --> indent, literal( Volumes ), ";", newline. literal_action( Transition, Result ) --> indent, "- ", literal( Transition ), " giving:", newline, indent, indent, literal( Result ), newline. literal( empty_into(From,To) ) --> "Empty the ", literal( From ), " into the ", literal( To ). literal( fill_from(From,To) ) --> "Fill the ", literal( To ), " from the ", literal( From ). literal( jugs(Small,Large,Reservoir) ) --> literal_number( Small ), " gallons in the small jug, ", literal_number( Large ), " gallons in the large jug and ", literal_number( Reservoir ), " gallons in the reservoir". literal( small ) --> "small jug". literal( large ) --> "large jug". literal( reservoir ) --> "reservoir". literal_number( Number, Plus, Minus ) :- number( Number ), number_chars( Number, Chars ), append( Chars, Minus, Plus ). indent --> " ". newline --> " ". </pre> ==Utility Predicates== Load a small library of [[Puzzle Utilities]]. <pre class="prolog"> :- ensure_loaded( misc ). </pre> The code is available as plain text [https://binding-time.co.uk/download/water_jugs.txt here]. ==Output== The output of the program is: <div class="result"> <pre> ?- water_jugs. Given three jugs with capacities of: 3 gallons in the small jug, 4 gallons in the large jug and 8 gallons in the reservoir; To obtain the result: 0 gallons in the small jug, 2 gallons in the large jug and 6 gallons in the reservoir; Starting with: 0 gallons in the small jug, 0 gallons in the large jug and 8 gallons in the reservoir; Do the following: - Fill the small jug from the reservoir giving: 3 gallons in the small jug, 0 gallons in the large jug and 5 gallons in the reservoir - Empty the small jug into the large jug giving: 0 gallons in the small jug, 3 gallons in the large jug and 5 gallons in the reservoir - Fill the small jug from the reservoir giving: 3 gallons in the small jug, 3 gallons in the large jug and 2 gallons in the reservoir - Fill the large jug from the small jug giving: 2 gallons in the small jug, 4 gallons in the large jug and 2 gallons in the reservoir - Empty the large jug into the reservoir giving: 2 gallons in the small jug, 0 gallons in the large jug and 6 gallons in the reservoir - Empty the small jug into the large jug giving: 0 gallons in the small jug, 2 gallons in the large jug and 6 gallons in the reservoir yes </pre> </div> 7c119dc88cfe12109fd459f54017358afe7d7cad 189 169 2017-02-21T14:50:11Z John 2 wikitext text/x-wiki __NOTOC__ This classic AI problem is described in ''Artificial Intelligence'' as follows: <blockquote> &ldquo;You are given two jugs, a 4-gallon one and a 3-gallon one. Neither has any measuring markers on it. There is a tap that can be used to fill the jugs with water. How can you get exactly 2 gallons of water into the 4-gallon jug?&rdquo;. <cite>[https://www.amazon.co.uk/Artificial-Intelligence-Elaine-Rich/dp/0070522634/276-9442056-6625664?tag=bindingtimeli-21 E. Rich & K. Knight, Artificial Intelligence, 2nd edition, McGraw-Hill, 1991]</cite> </blockquote> This program implements an environmentally responsible solution to the ''water jugs'' problem. Rather than filling and spilling from an infinite water resource, we conserve a finite initial charge with a third jug: (reservoir). This approach is simpler than the traditional method because there are only two actions. It is more flexible than the traditional method because it can solve problems that are constrained by a limited supply from the reservoir. To simulate the infinite version, we use a filled reservoir with a capacity greater than the combined capacities of the jugs so that the reservoir can never be emptied. <blockquote> &ldquo;Perfection is achieved not when there is nothing more to add, but when there is nothing more to take away.&rdquo; <cite>[https://en.wikiquote.org/wiki/Antoine_de_Saint_Exup%C3%A9ry Antoine de Saint-Exup&#233;ry]</cite> </blockquote> ==Solution== ====water_jugs==== is the entry point. The solution is derived by a simple, breadth-first, state-space search, and translated into a readable format by a DCG. <pre class="prolog">water_jugs :- SmallCapacity = 3, LargeCapacity = 4, Reservoir is SmallCapacity + LargeCapacity + 1, volume( small, Capacities, SmallCapacity ), volume( large, Capacities, LargeCapacity ), volume( reservoir, Capacities, Reservoir ), volume( small, Start, 0 ), volume( large, Start, 0 ), volume( reservoir, Start, Reservoir ), volume( large, End, 2 ), water_jugs_solution( Start, Capacities, End, Solution ), phrase( narrative(Solution, Capacities, End), Chars ), put_chars( Chars ).</pre> ====water_jugs_solution( +Start, +Capacities, +End, ?Solution )==== holds when <var>Solution</var> is the terminal state in a state-space search that begins with an initial state, in which the water-jugs have <var>Capacities</var> and contain the <var>Start</var> volumes, and ends when the water-jugs contain the <var>End</var> volumes. <pre class="prolog"> water_jugs_solution( Start, Capacities, End, Solution ) :- solve_jugs( [start(Start)], Capacities, [], End, Solution ). </pre> ====solve_jugs( +Nodes, +Capacities, +Visited, +End, ?Solution )==== holds when <var>Solution</var> is the terminal node in a state-space search, beginning with a first open node in <var>Nodes</var>, and terminating when the water-jugs contain the <var>End</var> volumes. <var>Capacities</var> define the capacities of the water-jugs while <var>Visited</var> is a list of expanded (closed) node states. The breadth-first operation of solve_jugs is due to the existing <var>Nodes</var> being appended to the new nodes. (If the new nodes were appended to the existing nodes, the operation would be depth-first.) <pre class="prolog"> solve_jugs( [Node|Nodes], Capacities, Visited, End, Solution ) :- node_state( Node, State ), ( State = End -> Solution = Node ; otherwise -> findall( Successor, successor(Node, Capacities, Visited, Successor), Successors ), append( Nodes, Successors, NewNodes ), solve_jugs( NewNodes, Capacities, [State|Visited], End, Solution ) ). </pre> ====successor( +Node, +Capacities, +Visited, ?Successor )==== <var>Successor</var> is a successor of <var>Node</var>, for water-jugs with <var>Capacities</var>, if there is a legal transition from <var>Node</var>'s state to <var>Successor</var>'s state and <var>Successor</var>'s state is not a member of the <var>Visited</var> states. <pre class="prolog"> successor( Node, Capacities, Visited, Successor ) :- node_state( Node, State ), Successor = node(Action,State1,Node), jug_transition( State, Capacities, Action, State1 ), \+ member( State1, Visited ). </pre> ===Transition Rules=== ====jug_transition( +State, +Capacities, ?Action, ?SuccessorState )==== holds when <var>Action</var> describes a valid transition, from <var>State</var> to <var>SuccessorState</var>, for water-jugs with <var>Capacities</var>. There are two sorts of <var>Action</var>: * <code>empty_into(Source,Target)</code> valid if ''Source'' is not already empty and the combined contents from ''Source'' and ''Target'', in <var>State</var>, are not greater than the capacity of the ''Target'' jug. The ''Source'' jug becomes empty in <var>SuccessorState</var> while the ''Target'' jug acquires the combined contents of ''Source'' and ''Target'' in <var>State</var>. * <code>fill_from(Source,Target)</code> valid if ''Source'' is not already empty, and the combined contents from ''Source'' and ''Target'', in <var>State</var>, are greater than the capacity of the ''Target'' jug. The ''Target'' jug becomes full in <var>SuccessorState</var>, while ''Source'' retains the excess of the combined contents of ''Source'' and ''Target'' in <var>State</var>, over the capacity of the ''Target'' jug. In either case, the contents of the unused jug are unchanged. <pre class="prolog">jug_transition( State0, Capacities, Action, State1 ) :- volume( Source, State0, SourceContents ), SourceContents > 0, jug_permutation( Source, Target, Unused ), volume( Target, State0, TargetContents ), volume( Target, Capacities, TargetCapacity ), volume( Unused, State0, Unchanged ), volume( Unused, State1, Unchanged ), CombinedContents is SourceContents + TargetContents, ( CombinedContents =< TargetCapacity -> Action = empty_into(Source,Target), NewSourceContents = 0, NewTargetContents = CombinedContents ; CombinedContents > TargetCapacity -> Action = fill_from(Source,Target), NewSourceContents is CombinedContents-TargetCapacity, NewTargetContents = TargetCapacity ), volume( Source, State1, NewSourceContents ), volume( Target, State1, NewTargetContents ).</pre> ==Data Abstraction== ====volume( ?Jug, ?State, ?Volume )==== holds when <var>Jug</var> (large, small or reservoir) has <var>Volume</var> in <var>State</var>. <pre class="prolog"> volume( small, jugs(Small, _Large, _Reservoir), Small ). volume( large, jugs(_Small, Large, _Reservoir), Large ). volume( reservoir, jugs(_Small, _Large, Reservoir), Reservoir ). </pre> ====jug_permutation( ?Source, ?Target, ?Unused )==== holds when <var>Source</var>, <var>Target</var> and <var>Unused</var> are a permutation of <code>small</code>, <code>large</code> and <code>reservoir</code>. <pre class="prolog"> jug_permutation( Source, Target, Unused ) :- select( Source, [small, large, reservoir], Residue ), select( Target, Residue, [Unused] ). </pre> ====node_state( ?Node, ?State )==== holds when the contents of the water-jugs at <var>Node</var> are described by <var>State</var>. <pre class="prolog"> node_state( start(State), State ). node_state( node(_Transition, State, _Predecessor), State ). </pre> ==Definite Clause Grammar== ====narrative( +Solution, +Capacities, +End )/==== is a DCG presenting the water-jugs <var>Solution</var> in a readable format. The grammar is head-recursive because the <var>Solution</var> has the last node outermost. <pre class="prolog"> narrative( start(Start), Capacities, End ) --> "Given three jugs with capacities of:", newline, literal_volumes( Capacities ), "To obtain the result:", newline, literal_volumes( End ), "Starting with:", newline, literal_volumes( Start ), "Do the following:", newline. narrative( node(Transition, Result, Predecessor), Capacities, End ) --> narrative( Predecessor, Capacities, End ), literal_action( Transition, Result ). literal_volumes( Volumes ) --> indent, literal( Volumes ), ";", newline. literal_action( Transition, Result ) --> indent, "- ", literal( Transition ), " giving:", newline, indent, indent, literal( Result ), newline. literal( empty_into(From,To) ) --> "Empty the ", literal( From ), " into the ", literal( To ). literal( fill_from(From,To) ) --> "Fill the ", literal( To ), " from the ", literal( From ). literal( jugs(Small,Large,Reservoir) ) --> literal_number( Small ), " gallons in the small jug, ", literal_number( Large ), " gallons in the large jug and ", literal_number( Reservoir ), " gallons in the reservoir". literal( small ) --> "small jug". literal( large ) --> "large jug". literal( reservoir ) --> "reservoir". literal_number( Number, Plus, Minus ) :- number( Number ), number_chars( Number, Chars ), append( Chars, Minus, Plus ). indent --> " ". newline --> " ". </pre> ==Utility Predicates== Load a small library of [[Puzzle Utilities]]. <pre class="prolog"> :- ensure_loaded( misc ). </pre> The code is available as plain text [https://binding-time.co.uk/download/water_jugs.txt here]. ==Output== The output of the program is: <div class="result"> <pre> ?- water_jugs. Given three jugs with capacities of: 3 gallons in the small jug, 4 gallons in the large jug and 8 gallons in the reservoir; To obtain the result: 0 gallons in the small jug, 2 gallons in the large jug and 6 gallons in the reservoir; Starting with: 0 gallons in the small jug, 0 gallons in the large jug and 8 gallons in the reservoir; Do the following: - Fill the small jug from the reservoir giving: 3 gallons in the small jug, 0 gallons in the large jug and 5 gallons in the reservoir - Empty the small jug into the large jug giving: 0 gallons in the small jug, 3 gallons in the large jug and 5 gallons in the reservoir - Fill the small jug from the reservoir giving: 3 gallons in the small jug, 3 gallons in the large jug and 2 gallons in the reservoir - Fill the large jug from the small jug giving: 2 gallons in the small jug, 4 gallons in the large jug and 2 gallons in the reservoir - Empty the large jug into the reservoir giving: 2 gallons in the small jug, 0 gallons in the large jug and 6 gallons in the reservoir - Empty the small jug into the large jug giving: 0 gallons in the small jug, 2 gallons in the large jug and 6 gallons in the reservoir yes </pre> </div> 7ef09a7159a064b11aaa48840f3c30ebb7d4dcc9 194 189 2017-10-11T23:20:51Z John 2 make literal_number//3 portable. wikitext text/x-wiki __NOTOC__ This classic AI problem is described in ''Artificial Intelligence'' as follows: <blockquote> &ldquo;You are given two jugs, a 4-gallon one and a 3-gallon one. Neither has any measuring markers on it. There is a tap that can be used to fill the jugs with water. How can you get exactly 2 gallons of water into the 4-gallon jug?&rdquo;. <cite>[https://www.amazon.co.uk/Artificial-Intelligence-Elaine-Rich/dp/0070522634/276-9442056-6625664?tag=bindingtimeli-21 E. Rich & K. Knight, Artificial Intelligence, 2nd edition, McGraw-Hill, 1991]</cite> </blockquote> This program implements an environmentally responsible solution to the ''water jugs'' problem. Rather than filling and spilling from an infinite water resource, we conserve a finite initial charge with a third jug: (reservoir). This approach is simpler than the traditional method because there are only two actions. It is more flexible than the traditional method because it can solve problems that are constrained by a limited supply from the reservoir. To simulate the infinite version, we use a filled reservoir with a capacity greater than the combined capacities of the jugs so that the reservoir can never be emptied. <blockquote> &ldquo;Perfection is achieved not when there is nothing more to add, but when there is nothing more to take away.&rdquo; <cite>[https://en.wikiquote.org/wiki/Antoine_de_Saint_Exup%C3%A9ry Antoine de Saint-Exup&#233;ry]</cite> </blockquote> ==Solution== ====water_jugs==== is the entry point. The solution is derived by a simple, breadth-first, state-space search, and translated into a readable format by a DCG. <pre class="prolog">water_jugs :- SmallCapacity = 3, LargeCapacity = 4, Reservoir is SmallCapacity + LargeCapacity + 1, volume( small, Capacities, SmallCapacity ), volume( large, Capacities, LargeCapacity ), volume( reservoir, Capacities, Reservoir ), volume( small, Start, 0 ), volume( large, Start, 0 ), volume( reservoir, Start, Reservoir ), volume( large, End, 2 ), water_jugs_solution( Start, Capacities, End, Solution ), phrase( narrative(Solution, Capacities, End), Chars ), put_chars( Chars ).</pre> ====water_jugs_solution( +Start, +Capacities, +End, ?Solution )==== holds when <var>Solution</var> is the terminal state in a state-space search that begins with an initial state, in which the water-jugs have <var>Capacities</var> and contain the <var>Start</var> volumes, and ends when the water-jugs contain the <var>End</var> volumes. <pre class="prolog"> water_jugs_solution( Start, Capacities, End, Solution ) :- solve_jugs( [start(Start)], Capacities, [], End, Solution ). </pre> ====solve_jugs( +Nodes, +Capacities, +Visited, +End, ?Solution )==== holds when <var>Solution</var> is the terminal node in a state-space search, beginning with a first open node in <var>Nodes</var>, and terminating when the water-jugs contain the <var>End</var> volumes. <var>Capacities</var> define the capacities of the water-jugs while <var>Visited</var> is a list of expanded (closed) node states. The breadth-first operation of solve_jugs is due to the existing <var>Nodes</var> being appended to the new nodes. (If the new nodes were appended to the existing nodes, the operation would be depth-first.) <pre class="prolog"> solve_jugs( [Node|Nodes], Capacities, Visited, End, Solution ) :- node_state( Node, State ), ( State = End -> Solution = Node ; otherwise -> findall( Successor, successor(Node, Capacities, Visited, Successor), Successors ), append( Nodes, Successors, NewNodes ), solve_jugs( NewNodes, Capacities, [State|Visited], End, Solution ) ). </pre> ====successor( +Node, +Capacities, +Visited, ?Successor )==== <var>Successor</var> is a successor of <var>Node</var>, for water-jugs with <var>Capacities</var>, if there is a legal transition from <var>Node</var>'s state to <var>Successor</var>'s state and <var>Successor</var>'s state is not a member of the <var>Visited</var> states. <pre class="prolog"> successor( Node, Capacities, Visited, Successor ) :- node_state( Node, State ), Successor = node(Action,State1,Node), jug_transition( State, Capacities, Action, State1 ), \+ member( State1, Visited ). </pre> ===Transition Rules=== ====jug_transition( +State, +Capacities, ?Action, ?SuccessorState )==== holds when <var>Action</var> describes a valid transition, from <var>State</var> to <var>SuccessorState</var>, for water-jugs with <var>Capacities</var>. There are two sorts of <var>Action</var>: * <code>empty_into(Source,Target)</code> valid if ''Source'' is not already empty and the combined contents from ''Source'' and ''Target'', in <var>State</var>, are not greater than the capacity of the ''Target'' jug. The ''Source'' jug becomes empty in <var>SuccessorState</var> while the ''Target'' jug acquires the combined contents of ''Source'' and ''Target'' in <var>State</var>. * <code>fill_from(Source,Target)</code> valid if ''Source'' is not already empty, and the combined contents from ''Source'' and ''Target'', in <var>State</var>, are greater than the capacity of the ''Target'' jug. The ''Target'' jug becomes full in <var>SuccessorState</var>, while ''Source'' retains the excess of the combined contents of ''Source'' and ''Target'' in <var>State</var>, over the capacity of the ''Target'' jug. In either case, the contents of the unused jug are unchanged. <pre class="prolog">jug_transition( State0, Capacities, Action, State1 ) :- volume( Source, State0, SourceContents ), SourceContents > 0, jug_permutation( Source, Target, Unused ), volume( Target, State0, TargetContents ), volume( Target, Capacities, TargetCapacity ), volume( Unused, State0, Unchanged ), volume( Unused, State1, Unchanged ), CombinedContents is SourceContents + TargetContents, ( CombinedContents =< TargetCapacity -> Action = empty_into(Source,Target), NewSourceContents = 0, NewTargetContents = CombinedContents ; CombinedContents > TargetCapacity -> Action = fill_from(Source,Target), NewSourceContents is CombinedContents-TargetCapacity, NewTargetContents = TargetCapacity ), volume( Source, State1, NewSourceContents ), volume( Target, State1, NewTargetContents ).</pre> ==Data Abstraction== ====volume( ?Jug, ?State, ?Volume )==== holds when <var>Jug</var> (large, small or reservoir) has <var>Volume</var> in <var>State</var>. <pre class="prolog"> volume( small, jugs(Small, _Large, _Reservoir), Small ). volume( large, jugs(_Small, Large, _Reservoir), Large ). volume( reservoir, jugs(_Small, _Large, Reservoir), Reservoir ). </pre> ====jug_permutation( ?Source, ?Target, ?Unused )==== holds when <var>Source</var>, <var>Target</var> and <var>Unused</var> are a permutation of <code>small</code>, <code>large</code> and <code>reservoir</code>. <pre class="prolog"> jug_permutation( Source, Target, Unused ) :- select( Source, [small, large, reservoir], Residue ), select( Target, Residue, [Unused] ). </pre> ====node_state( ?Node, ?State )==== holds when the contents of the water-jugs at <var>Node</var> are described by <var>State</var>. <pre class="prolog"> node_state( start(State), State ). node_state( node(_Transition, State, _Predecessor), State ). </pre> ==Definite Clause Grammar== ====narrative( +Solution, +Capacities, +End )/==== is a DCG presenting the water-jugs <var>Solution</var> in a readable format. The grammar is head-recursive because the <var>Solution</var> has the last node outermost. <pre class="prolog"> narrative( start(Start), Capacities, End ) --> "Given three jugs with capacities of:", newline, literal_volumes( Capacities ), "To obtain the result:", newline, literal_volumes( End ), "Starting with:", newline, literal_volumes( Start ), "Do the following:", newline. narrative( node(Transition, Result, Predecessor), Capacities, End ) --> narrative( Predecessor, Capacities, End ), literal_action( Transition, Result ). literal_volumes( Volumes ) --> indent, literal( Volumes ), ";", newline. literal_action( Transition, Result ) --> indent, "- ", literal( Transition ), " giving:", newline, indent, indent, literal( Result ), newline. literal( empty_into(From,To) ) --> "Empty the ", literal( From ), " into the ", literal( To ). literal( fill_from(From,To) ) --> "Fill the ", literal( To ), " from the ", literal( From ). literal( jugs(Small,Large,Reservoir) ) --> literal_number( Small ), " gallons in the small jug, ", literal_number( Large ), " gallons in the large jug and ", literal_number( Reservoir ), " gallons in the reservoir". literal( small ) --> "small jug". literal( large ) --> "large jug". literal( reservoir ) --> "reservoir". literal_number( Number, Plus, Minus ) :- number( Number ), name( Number, Chars ), append( Chars, Minus, Plus ). indent --> " ". newline --> " ". </pre> ==Utility Predicates== Load a small library of [[Puzzle Utilities]]. <pre class="prolog"> :- ensure_loaded( misc ). </pre> The code is available as plain text [https://binding-time.co.uk/download/water_jugs.txt here]. ==Output== The output of the program is: <div class="result"> <pre> ?- water_jugs. Given three jugs with capacities of: 3 gallons in the small jug, 4 gallons in the large jug and 8 gallons in the reservoir; To obtain the result: 0 gallons in the small jug, 2 gallons in the large jug and 6 gallons in the reservoir; Starting with: 0 gallons in the small jug, 0 gallons in the large jug and 8 gallons in the reservoir; Do the following: - Fill the small jug from the reservoir giving: 3 gallons in the small jug, 0 gallons in the large jug and 5 gallons in the reservoir - Empty the small jug into the large jug giving: 0 gallons in the small jug, 3 gallons in the large jug and 5 gallons in the reservoir - Fill the small jug from the reservoir giving: 3 gallons in the small jug, 3 gallons in the large jug and 2 gallons in the reservoir - Fill the large jug from the small jug giving: 2 gallons in the small jug, 4 gallons in the large jug and 2 gallons in the reservoir - Empty the large jug into the reservoir giving: 2 gallons in the small jug, 0 gallons in the large jug and 6 gallons in the reservoir - Empty the small jug into the large jug giving: 0 gallons in the small jug, 2 gallons in the large jug and 6 gallons in the reservoir yes </pre> </div> 13969ba826d2f654fa779718916265d9b49522fb 0 17 167 141 2016-12-27T22:49:46Z John 2 /* Download */ wikitext text/x-wiki __NOTOC__ == Terms and Conditions == This program is offered free of charge as unsupported source code. You may use it, copy it, distribute it, modify it or sell it without restriction. I hope that it will be useful to you, but it is provided &quot;as is&quot; without any warranty express or implied, including but not limited to the warranty of non-infringement and the implied warranties of merchantability and fitness for a particular purpose. == Download == <pre>Current Version: XML Module 3.7 released 2014/07/09 Windows application plxml 4.0 released 2016/12/27 </pre> [https://binding-time.co.uk/download/xmlpl.tar.gz Download the source code] in tar.gz format (21KB) [https://binding-time.co.uk/download/xmlpl.zip Download the source code and Windows application] as a ZIP file (431KB). ''Substantial XML input performance improvement in version 4.0''. == Extracting the files == Unzip the files to create a folder structure as follows: <pre>+---bin | | plxml.exe : Application | | libpl.dll : Quintus Prolog support DLL | | libqp.dll : &quot; &quot; &quot; &quot; | | qpconsole.dll : &quot; &quot; &quot; &quot; | | qpeng.dll : &quot; &quot; &quot; &quot; | +---source | xml.pl : Quintus Prolog module wrapper | xml.iso.pl : ISO Prolog module wrapper | xml.lpa.pl : LPA Prolog wrapper | xml_driver.pl : Driver | xml_acquisition.pl : Chars -&gt; Document parsing | xml_generation.pl : Document -&gt; Chars parsing | xml_diagnosis.pl : Document -&gt; Chars parsing exception | xml_pp.pl : Document pretty-printing | xml_utilities.pl : Shared code</pre> == The Source Code (xml.pl) == xml is intended to be a modular module: it should be easy to build a program that can output XML, but not read it, or vice versa. Similarly, you may be happy to dispense with diagnosis once you are sure that your code will only try to make valid calls to xml_parse/2. It is intended that the code should be very portable too. Clearly, some small changes will be needed between platforms, but these should be limited to the top-level wrapper file which contains the potentially non-portable code. It is suggested that you name the wrapper file you need as xml.pl == Using plxml.exe == The application and the DLLs should reside in the same directory, unless you have a good reason to do something different. The application is invoked with two file names as operands, i.e. plxml [-(c|p|a)*] INPUT OUTPUT If INPUT contains a Prolog xml/2 clause, OUTPUT is written as the corresponding XML. If INPUT contains a Prolog malformed/2 clause, OUTPUT is written as the corresponding XML with the unparsed/1 and out_of_context/1 terms written as CDATA. If INPUT is an XML file, OUTPUT is written as a Prolog xml/2 or malformed/2 clause. INPUT and/or OUTPUT may be &quot;-&quot; indicating stdin/stdout respectively. ; The -a option : allows unescaped &amp; (ampersand) characters to occur in PCDATA - an increasingly common fault in the XML &quot;in the wild&quot;; ; The -p option : preserves whitespace; ; The -c option : causes prefixes to be removed from attribute names if the explicitly denoted namespace is that of the containing tag - i.e. is the namespace implicitly specified (XML input only); Plxml's Prolog output is compatible with [http://www.lpa.co.uk/ LPA Prolog]. Specifically, strings containing ~ (tilde) characters are output as lists of character codes. === Using plxml as a development tool === A common use of xml.pl is to populate template XML documents with answers from a Prolog application. A nice approach is to design a prototype document and then translate this into an xml/2 term with plxml. For example, a prototype HTML page could be produced with a WYSIWYG XHTML editor. Alternatively, if your editor produces plain HTML, you can use plxml in combination with [http://www.htacg.org/ HTML Tidy] e.g. tidy -asxhtml -ascii [HTMLFile] | plxml - [PLFile] Similarly, during prototyping/early development it may be convenient to use plxml as the interface, rather than integrating xml.pl itself. === Using plxml to repair XML === plxml can repair broken XML, sometimes: plxml -ac [Broken XML] - | plxml - [Fixed XML] === Character Encoding === By default, plxml can accept input encoded as UTF-8 or UTF-16, which encompasses plain 7-bit ASCII. The iso-8859-1, iso-8859-2, iso-8859-15 and windows-1252 8-bit encodings are supported, but they must be identified correctly in the signature of the XML document. xml.pl, (and therefore plxml), output a plain ASCII encoding with the following properties: * In all character data, the characters &amp; &lt; and &gt; are encoded as &amp;amp; &amp;lt; and &amp;gt; respectively. * In non-parsed character data, such as Attribute Values, the characters &quot; and ' are encoded as &amp;quot; and &amp;apos; respectively. * Any character codes &gt; 127 are output as decimal character entities e.g. 160 as &amp;#160;. * Only [http://www.w3.org/TR/2000/REC-xml-20001006#NT-Char character codes allowed by the XML specification] are encoded by xml_parse/[2,3]. f0cf6fdeb7216e26d6e7cf7e7797419568ffd1ae 186 167 2017-02-20T13:51:13Z John 2 /* Using plxml.exe */ wikitext text/x-wiki __NOTOC__ == Terms and Conditions == This program is offered free of charge as unsupported source code. You may use it, copy it, distribute it, modify it or sell it without restriction. I hope that it will be useful to you, but it is provided &quot;as is&quot; without any warranty express or implied, including but not limited to the warranty of non-infringement and the implied warranties of merchantability and fitness for a particular purpose. == Download == <pre>Current Version: XML Module 3.7 released 2014/07/09 Windows application plxml 4.0 released 2016/12/27 </pre> [https://binding-time.co.uk/download/xmlpl.tar.gz Download the source code] in tar.gz format (21KB) [https://binding-time.co.uk/download/xmlpl.zip Download the source code and Windows application] as a ZIP file (431KB). ''Substantial XML input performance improvement in version 4.0''. == Extracting the files == Unzip the files to create a folder structure as follows: <pre>+---bin | | plxml.exe : Application | | libpl.dll : Quintus Prolog support DLL | | libqp.dll : &quot; &quot; &quot; &quot; | | qpconsole.dll : &quot; &quot; &quot; &quot; | | qpeng.dll : &quot; &quot; &quot; &quot; | +---source | xml.pl : Quintus Prolog module wrapper | xml.iso.pl : ISO Prolog module wrapper | xml.lpa.pl : LPA Prolog wrapper | xml_driver.pl : Driver | xml_acquisition.pl : Chars -&gt; Document parsing | xml_generation.pl : Document -&gt; Chars parsing | xml_diagnosis.pl : Document -&gt; Chars parsing exception | xml_pp.pl : Document pretty-printing | xml_utilities.pl : Shared code</pre> == The Source Code (xml.pl) == xml is intended to be a modular module: it should be easy to build a program that can output XML, but not read it, or vice versa. Similarly, you may be happy to dispense with diagnosis once you are sure that your code will only try to make valid calls to xml_parse/2. It is intended that the code should be very portable too. Clearly, some small changes will be needed between platforms, but these should be limited to the top-level wrapper file which contains the potentially non-portable code. It is suggested that you name the wrapper file you need as xml.pl == Using plxml.exe == The application and the DLLs should reside in the same directory, unless you have a good reason to do something different. The application is invoked with two file names as operands, i.e. plxml [-(c|p|a)*] INPUT OUTPUT If INPUT contains a Prolog xml/2 clause, OUTPUT is written as the corresponding XML. If INPUT contains a Prolog malformed/2 clause, OUTPUT is written as the corresponding XML with the unparsed/1 and out_of_context/1 terms written as CDATA. If INPUT is an XML file, OUTPUT is written as a Prolog xml/2 or malformed/2 clause. INPUT and/or OUTPUT may be &quot;-&quot; indicating stdin/stdout respectively. ; The -a option : allows unescaped &amp; (ampersand) characters to occur in PCDATA; ; The -p option : preserves whitespace; ; The -c option : causes prefixes to be removed from attribute names if the explicitly denoted namespace is the same as that of the containing tag (XML input only); Plxml's Prolog output is compatible with [http://www.lpa.co.uk/ LPA Prolog]. Specifically, strings containing ~ (tilde) characters are output as lists of character codes. === Using plxml as a development tool === A common use of xml.pl is to populate template XML documents with answers from a Prolog application. A nice approach is to design a prototype document and then translate this into an xml/2 term with plxml. For example, a prototype HTML page could be produced with a WYSIWYG XHTML editor. Alternatively, if your editor produces plain HTML, you can use plxml in combination with [http://www.htacg.org/ HTML Tidy] e.g. tidy -asxhtml -ascii [HTMLFile] | plxml - [PLFile] Similarly, during prototyping/early development it may be convenient to use plxml as the interface, rather than integrating xml.pl itself. === Using plxml to repair XML === plxml can sometimes repair broken XML: plxml -ac [Broken XML] - | plxml - [Fixed XML] === Character Encoding === By default, plxml can accept input encoded as UTF-8 or UTF-16, which encompasses plain 7-bit ASCII. The iso-8859-1, iso-8859-2, iso-8859-15 and windows-1252 8-bit encodings are supported, but they must be identified correctly in the signature of the XML document. xml.pl, (and therefore plxml), output a plain ASCII encoding with the following properties: * In all character data, the characters &amp; &lt; and &gt; are encoded as &amp;amp; &amp;lt; and &amp;gt; respectively. * In non-parsed character data, such as ''Attribute Values'', the characters &quot; and ' are encoded as &amp;quot; and &amp;apos; respectively. * Any character codes &gt; 127 are output as decimal character entities e.g. 160 as &amp;#160;. * Only [http://www.w3.org/TR/2000/REC-xml-20001006#NT-Char character codes allowed by the XML specification] are encoded by xml_parse/[2,3]. cfb96fcb807124eb52349af27cedb1ed2fe96a07 187 186 2017-02-20T13:52:56Z John 2 /* Using plxml as a development tool */ wikitext text/x-wiki __NOTOC__ == Terms and Conditions == This program is offered free of charge as unsupported source code. You may use it, copy it, distribute it, modify it or sell it without restriction. I hope that it will be useful to you, but it is provided &quot;as is&quot; without any warranty express or implied, including but not limited to the warranty of non-infringement and the implied warranties of merchantability and fitness for a particular purpose. == Download == <pre>Current Version: XML Module 3.7 released 2014/07/09 Windows application plxml 4.0 released 2016/12/27 </pre> [https://binding-time.co.uk/download/xmlpl.tar.gz Download the source code] in tar.gz format (21KB) [https://binding-time.co.uk/download/xmlpl.zip Download the source code and Windows application] as a ZIP file (431KB). ''Substantial XML input performance improvement in version 4.0''. == Extracting the files == Unzip the files to create a folder structure as follows: <pre>+---bin | | plxml.exe : Application | | libpl.dll : Quintus Prolog support DLL | | libqp.dll : &quot; &quot; &quot; &quot; | | qpconsole.dll : &quot; &quot; &quot; &quot; | | qpeng.dll : &quot; &quot; &quot; &quot; | +---source | xml.pl : Quintus Prolog module wrapper | xml.iso.pl : ISO Prolog module wrapper | xml.lpa.pl : LPA Prolog wrapper | xml_driver.pl : Driver | xml_acquisition.pl : Chars -&gt; Document parsing | xml_generation.pl : Document -&gt; Chars parsing | xml_diagnosis.pl : Document -&gt; Chars parsing exception | xml_pp.pl : Document pretty-printing | xml_utilities.pl : Shared code</pre> == The Source Code (xml.pl) == xml is intended to be a modular module: it should be easy to build a program that can output XML, but not read it, or vice versa. Similarly, you may be happy to dispense with diagnosis once you are sure that your code will only try to make valid calls to xml_parse/2. It is intended that the code should be very portable too. Clearly, some small changes will be needed between platforms, but these should be limited to the top-level wrapper file which contains the potentially non-portable code. It is suggested that you name the wrapper file you need as xml.pl == Using plxml.exe == The application and the DLLs should reside in the same directory, unless you have a good reason to do something different. The application is invoked with two file names as operands, i.e. plxml [-(c|p|a)*] INPUT OUTPUT If INPUT contains a Prolog xml/2 clause, OUTPUT is written as the corresponding XML. If INPUT contains a Prolog malformed/2 clause, OUTPUT is written as the corresponding XML with the unparsed/1 and out_of_context/1 terms written as CDATA. If INPUT is an XML file, OUTPUT is written as a Prolog xml/2 or malformed/2 clause. INPUT and/or OUTPUT may be &quot;-&quot; indicating stdin/stdout respectively. ; The -a option : allows unescaped &amp; (ampersand) characters to occur in PCDATA; ; The -p option : preserves whitespace; ; The -c option : causes prefixes to be removed from attribute names if the explicitly denoted namespace is the same as that of the containing tag (XML input only); Plxml's Prolog output is compatible with [http://www.lpa.co.uk/ LPA Prolog]. Specifically, strings containing ~ (tilde) characters are output as lists of character codes. === Using plxml as a development tool === A common use of xml.pl is to populate template XML documents with answers from a Prolog application. A nice approach is to design a prototype document and then translate this into an xml/2 term with plxml. For example, a prototype HTML page could be produced with a WYSIWYG XHTML editor. Alternatively, if your editor produces plain HTML, you can use plxml in combination with [http://www.htacg.org/ HTML Tidy] e.g. tidy -asxhtml -ascii [HTMLFile] | plxml - [PLFile] Similarly, during prototyping/early development it may be convenient to use plxml as the interface, rather than integrating xml.pl. === Using plxml to repair XML === plxml can sometimes repair broken XML: plxml -ac [Broken XML] - | plxml - [Fixed XML] === Character Encoding === By default, plxml can accept input encoded as UTF-8 or UTF-16, which encompasses plain 7-bit ASCII. The iso-8859-1, iso-8859-2, iso-8859-15 and windows-1252 8-bit encodings are supported, but they must be identified correctly in the signature of the XML document. xml.pl, (and therefore plxml), output a plain ASCII encoding with the following properties: * In all character data, the characters &amp; &lt; and &gt; are encoded as &amp;amp; &amp;lt; and &amp;gt; respectively. * In non-parsed character data, such as ''Attribute Values'', the characters &quot; and ' are encoded as &amp;quot; and &amp;apos; respectively. * Any character codes &gt; 127 are output as decimal character entities e.g. 160 as &amp;#160;. * Only [http://www.w3.org/TR/2000/REC-xml-20001006#NT-Char character codes allowed by the XML specification] are encoded by xml_parse/[2,3]. eb078c132f94901fbe1e97c429a3764155efefd7 0 2 170 140 2017-01-05T20:50:24Z John 2 Remove broken syntax highlighting wikitext text/x-wiki __NOTOC__ ==Problem Definition== We are given 12 apparently identical coins - one of which is counterfeit. We know that the counterfeit has a different weight from the others, but we don't know if it's heavier or lighter. ===Task:=== Devise a procedure to identify any counterfeit coin using a balance to take up to three comparative weighings. ==Strategy== The information from three suitable weighings will make all but one of the coins, which are untested initially, known_true. There are three alternative deductions that make a coin known_true: * if it is not_heavy and not_light &ndash; having been on both the comparatively lighter and heavier sides of imbalances; * if it was excluded from an imbalance; * if it was included in a balanced weighing. After three weighings there must be exactly one coin, the counterfeit, which is not known_true. If the counterfeit is not known_true and not_heavy we deduce that it must be light. If it is not known_true and not_light, it must be heavy. We use a generate-and-test method as follows: * Create the set of all possible counterfeits: 12 coins &times; 2 weights ; * Devise a procedure that can identify the first counterfeit coin; * Show that the same procedure works for every other counterfeit coin. ==Entry Point== ====go==== is the entry point. It solves the puzzle, then uses a DCG to pretty-print the resulting procedure. <pre class="prolog"> go :- coins_puzzle( Procedure ), phrase( general_explanation( Procedure ), Chars ), put_chars( Chars ). </pre> ====coins_puzzle( ?Procedure )==== generates the set of all possible counterfeit coins and finds, or proves, that <var>Procedure</var> can identify them all. <pre class="prolog"> coins_puzzle( Procedure ) :- coins( Coins ), counterfeit( Counterfeit, Coin, Weight ), findall( Counterfeit, (member(Coin,Coins), counterfeit_weight(Weight)), Counterfeits ), coins_puzzle_solution( Counterfeits, Procedure ). coins_puzzle_solution( [], _Procedure ). coins_puzzle_solution( [Counterfeit|Counterfeits], Procedure ) :- solve_coins( Counterfeit, Procedure ), coins_puzzle_solution( Counterfeits, Procedure ). </pre> A procedure is either &lsquo;done&rsquo;, identifying a particular coin and whether it is heavy or light; or it is a &lsquo;step&rsquo;. A step defines the coins to be placed on the <var>Left</var> and <var>Right</var> pans, with the residue remaining on the <var>Table</var>, and three <var>Branches</var>, one of which will be chosen depending on the outcome of the weighing. <pre class="prolog"> step( step(Left,Right,Table,Branches), Left, Right, Table, Branches). </pre> The <var>Branches</var> are three procedures equating to: * > (left pan heavier), * < (right pan heavier) and * <nowiki>= (pans balance).</nowiki> <pre class="prolog"> branch( >, branches(_Equal, GT, _LT), GT ). branch( <, branches(_Equal, _GT, LT), LT ). branch( =, branches(Equal, _GT, _LT), Equal ). </pre> The counterfeit is defined by its number and whether it is heavy or light. <pre class="prolog"> counterfeit( counterfeit(Coin, HeavyOrLight), Coin, HeavyOrLight ). coins( [1,2,3,4,5,6,7,8,9,10,11,12] ). counterfeit_weight( heavy ). counterfeit_weight( light ). </pre> A &lsquo;coin collection&rsquo; comprises four &lsquo;parts&rsquo; (subsets): the <code>known_true</code>, <code>not_heavy</code>, <code>not_light</code> and <code>untested</code> sets of coins. <pre class="prolog"> part( known_true, collection(Coins,_,_,_), Coins ). part( not_heavy, collection(_,Coins,_,_), Coins ). part( not_light, collection(_,_,Coins,_), Coins ). part( untested, collection(_,_,_,Coins), Coins ). </pre> ==Solution== ====solve_coins( +Counterfeit, ?Procedure )==== holds when <var>Procedure</var> can correctly identify the <var>Counterfeit</var> coin. Beginning with a &lsquo;start&rsquo; collection, in which all the coins are untested, the <var>Procedure</var> comprises three &lsquo;steps&rsquo;. For each step, a weighing is made and a &lsquo;branch&rsquo; is made in the <var>Procedure</var>, depending on the result of the weighing. After three steps, the <var>Procedure</var> must have reached the &lsquo;end&rsquo; condition. Finally, an assertion (redundant test) ensures that the <var>Procedure</var> has found the correct end condition. <pre class="prolog"> solve_coins( Counterfeit, Procedure ) :- start( Coins0 ), assay( Counterfeit, Coins0, Procedure, Branch1, Coins1 ), assay( Counterfeit, Coins1, Branch1, Branch2, Coins2 ), assay( Counterfeit, Coins2, Branch2, done(Coin, HeavyOrLight), Coins3 ), end( Coins3, Coin, HeavyOrLight ), counterfeit( Counterfeit, Coin, HeavyOrLight ). start( Coins ) :- coins( Untested ), part( untested, Coins, Untested ), part( not_heavy, Coins, [] ), part( not_light, Coins, [] ), part( known_true, Coins, [] ). end( Coins, Coin, HeavyOrLight ) :- part( untested, Coins, [] ), part( not_heavy, Coins, Light ), part( not_light, Coins, Heavy ), end_result( Heavy, Light, Coin, HeavyOrLight ). end_result( [Coin], [], Coin, heavy ). end_result( [], [Coin], Coin, light ). </pre> === Simulating the weighing process === ====assay( +Counterfeit, +Coins0, ?Step, ?Branch, ?Coins1 )==== holds when the appropriate <var>Branch</var> from <var>Step</var> is chosen by comparing the weights of two coin collections taken from the full set of coins: <var>Coins0</var>. <var>Coins1</var> is the full set of coins, updated with the inferences drawn from the weighing. <var>Counterfeit</var> is used to determine the result of the weighing. This predicate applies the critical insight into the solution of this puzzle: we have 24 (12 &times; 2) possible inputs to the procedure, with only 27 (3 &times; 3 &times; 3) possible outcomes from the weighings. Therefore, it is clear that each weighing must have a very high [[#Information Content|information content]]. Choosing which weighing to make by estimating the available information content makes the problem tractable. <pre class="prolog"> assay( Counterfeit, Coins0, Step, Branch, Coins ) :- WeighingDatum = weighing_data(InfoContent, Left, Right, Table), step( Step, Left, Right, Table, Branches ), findall( WeighingDatum, valid_partition( Coins0, InfoContent, Left, Right, Table ), WeighingData ), sort( WeighingData, OrderedWeighingData ), member( WeighingDatum, OrderedWeighingData ), balance( Left, Right, Counterfeit, Result ), draw_inferences( Result, Left, Right, Table, Coins ), branch( Result, Branches, Branch ). </pre> ====balance( +Left, +Right, +Counterfeit, ?Result )==== holds when <var>Result</var> simulates the outcome of testing the coin collections <var>Left</var> and <var>Right</var> with a balance, where either may contain the <var>Counterfeit</var> coin. <pre class="prolog"> balance( Left, Right, Counterfeit, Result ):- counterfeit( Counterfeit, Coin, Weight ), ( contains_coin( Left, Coin ) -> balance_result( Weight, normal, Result ) ; contains_coin( Right, Coin ) -> balance_result( normal, Weight, Result ) ; otherwise -> Result = '=' ). balance_result( light, normal, < ). balance_result( heavy, normal, > ). balance_result( normal, heavy, < ). balance_result( normal, light, > ). </pre> ===Choosing which coins to weigh=== ====valid_partition( +Coins, ?Content, ?Left, ?Right, ?Table )==== holds when <var>Coins</var> can be partitioned into three collections: <var>Left</var> side, <var>Right</var> side and <var>Table</var>; with the information content of the partition given by <var>Content</var>. The definition of a valid_partition ensures that: * <var>Left</var> and <var>Right</var> must have the same number of coins (at least one); * <var>Left</var> cannot contain any known_true coins, because adding true coins to both sides creates redundant comparisons; * Comparisons between mixtures of coins where only the choice of pans is different are equivalent; so a partial order (&ge;) on mixtures of coins is used to eliminate some redundant comparisons. <pre class="prolog"> valid_partition( Coins, Content, Left, Right, Table ):- part( known_true, Left, [] ), selection( Coins, Left, Coins1, LeftSum, LeftInfo ), selection( Coins1, Right, Table, RightSum, RightInfo ), LeftSum =:= RightSum, LeftSum @>= RightSum, table_information( Table, TableInfo ), sum( [LeftInfo,RightInfo,TableInfo], Content ). </pre> ====selection( +Coins, ?Sample, ?Residue, ?Sum, ?Content )==== holds when <var>Coins</var> is partitioned into two collections: <var>Sample</var> and <var>Residue</var>. <var>Sum</var> is used as both a fingerprint for the mixture of coins in <var>Sample</var> and a representation of the number of coins in <var>Sample</var>. <var>Content</var> estimates the information-content of <var>Sample</var>. <pre class="prolog"> selection( Coins, Sample, Residue, Sum, Content ) :- Sum = Count1+Count2+Count3+Count4, select_coins( not_heavy, Coins, Sample, Residue, Count1 ), select_coins( not_light, Coins, Sample, Residue, Count2 ), select_coins( untested, Coins, Sample, Residue, Count3 ), select_coins( known_true, Coins, Sample, Residue, Count4 ), Sum >= 1, Sum =< 6, information_content( [Count1,Count2,Count3,Count4], Content ). </pre> ====table_information( +Coins, ?Content )==== holds when <var>Coins</var> has 'information content' <var>Content</var>. <pre class="prolog"> table_information( Coins, Content ) :- count_coins( not_heavy, Coins, Count1 ), count_coins( not_light, Coins, Count2 ), count_coins( untested, Coins, Count3 ), count_coins( known_true, Coins, Count4 ), information_content( [Count1,Count2,Count3,Count4], Content ). count_coins( Part, Coins, Count ) :- part( Part, Coins, Selection ), length( Selection, Count ). </pre> === Updating what is known about the coins === ====draw_inferences( +Result, +Left, +Right, +Table, ?Coins )==== holds when <var>Result</var> is one of: * > (imbalance &ndash; left pan heavier), * < (imbalance &ndash; right pan heavier) or * <nowiki>=</nowiki> (pans balanced) from taking a weighing with the coin collections: <var>Left</var>, <var>Right</var> and <var>Table</var>. <var>Coins</var> is derived from this information using the following rules: * If the pans are unbalanced then only the previously untested or not_heavy coins on the lighter side of the balance are now not_heavy. Similarly, only the previously untested or not_light coins on the heavier side of the balance are now not_light. All the coins on the table are now known_true. * If the pans balance then all the coins weighed are known_true, with the coins on the <var>Table</var> left in their prior states. <pre class="prolog"> draw_inferences( <, Left, Right, Table, Coins ) :- imbalance_inferences( Left, Right, Table, Coins ). draw_inferences( >, Left, Right, Table, Coins ) :- imbalance_inferences( Right, Left, Table, Coins ). draw_inferences( =, Left, Right, Table, Coins ) :- becomes( [all(Left),known_true(Table),all(Right)], known_true( Coins ) ), becomes( untested(Table), untested(Coins) ), becomes( not_heavy(Table), not_heavy(Coins) ), becomes( not_light(Table), not_light(Coins) ). </pre> ====imbalance_inferences( +Lighter, +Heavier, +Table, ?Coins )==== holds when: * Only the untested or not_heavy coins in <var>Lighter</var> are not_heavy in <var>Coins</var>; * Only the untested or not_light coins in <var>Heavier</var> are not_light in <var>Coins</var>; * All the other coins in <var>Lighter</var> and <var>Heavier</var> and all the coins in <var>Table</var> are known_true in <var>Coins</var>; There are no untested coins in <var>Coins</var>. <pre class="prolog"> imbalance_inferences( Lighter, Heavier, Table, Coins ) :- becomes( [untested(Lighter),not_heavy(Lighter)], not_heavy(Coins) ), becomes( [untested(Heavier),not_light(Heavier)], not_light(Coins) ), becomes( [ known_true(Lighter), not_light(Lighter), known_true(Heavier), not_heavy(Heavier), all(Table) ], known_true(Coins) ), part( untested, Coins, [] ). </pre> ====becomes( +CollectionA, ?CollectionB )==== <var>CollectionA</var> becomes (part) <var>CollectionB</var> when <var>CollectionB</var> comprises the same coins as <var>CollectionA</var>. <pre class="prolog"> becomes( CollectionA, CollectionB ) :- unfolded( CollectionA, Coins ), unfolded( CollectionB, Coins ). </pre> ====unfolded( +Collection, ?Coins )==== holds when (part) <var>Collection</var> comprises <var>Coins</var>. <pre class="prolog"> unfolded( not_light(Collection), Coins ) :- part( not_light, Collection, Coins ). unfolded( not_heavy(Collection), Coins ) :- part( not_heavy, Collection, Coins ). unfolded( known_true(Collection), Coins ) :- part( known_true, Collection, Coins ). unfolded( untested(Collection), Coins ) :- part( untested, Collection, Coins ). unfolded( all(Collection), Coins ) :- collection_to_set( Collection, Coins ). unfolded( [Item|Items], Coins ) :- unfolded( Item, Value ), unfolded1( Items, Value, Coins ). unfolded1( [], Coins, Coins ). unfolded1( [Item|Items], Value, Coins ) :- unfolded( Item, Value0 ), ord_union( Value0, Value, Value1 ), unfolded1( Items, Value1, Coins ). </pre> ==Definite Clause Grammar== The following DCG represents the method for finding the counterfeit coin as a structured procedure. <pre class="prolog"> general_explanation( Procedure ) --> "Number the coins 1..12", newline, explanation( Procedure, 0 ). explanation( done(Coin, Weight), N ) --> tab( N ), "Conclude that the counterfeit coin is number ", literal( Coin ), ", which is ", literal( Weight ), newline. explanation( Step, N ) --> {step( Step, Left, Right, Table, Branches )}, tab( N ), "BEGIN", newline, tab( N ), "Put ", literal( Left ), " on the left-hand pan", newline, tab( N ), "Put ", literal( Right ), " on the right-hand pan", newline, tab( N ), "Leaving ", literal( Table ), " on the table", newline, branches_explained( Branches, N ), tab( N ), "END", newline. branches_explained( Branches, N ) --> next_step_explained( <, Branches, N ), next_step_explained( >, Branches, N ), next_step_explained( =, Branches, N ). next_step_explained( Result, Branch, N ) --> {branch( Result, Branch, Step )}, ( {var(Step)} -> "" | {nonvar(Step)} -> tab( N ), "If the ", literal( Result ), " then:", newline, explanation( Step, s(N) ) ). literal( 0 ) --> "0". literal( 1 ) --> "1". literal( 2 ) --> "2". literal( 3 ) --> "3". literal( 4 ) --> "4". literal( 5 ) --> "5". literal( 6 ) --> "6". literal( 7 ) --> "7". literal( 8 ) --> "8". literal( 9 ) --> "9". literal( 10 ) --> "10". literal( 11 ) --> "11". literal( 12 ) --> "12". literal( true ) --> "true". literal( heavy ) --> "heavy". literal( light ) --> "light". literal( = ) --> "pans balance". literal( < ) --> "right-hand pan is heavier". literal( > ) --> "left-hand pan is heavier". literal( Collection ) --> {collection_to_set( Collection , [H|T] )}, literal_set( T, H ). literal_set( [], Number ) --> "the coin numbered ", literal( Number ). literal_set( [H|T], Number ) --> "the coins numbered ", literal( Number ), literal_set1( T, H ). literal_set1( [], Number ) --> " and ", literal( Number ). literal_set1( [H|T], Number ) --> ", ", literal( Number ), literal_set1( T, H ). tab( 0 ) --> "". tab( s(N) ) --> " ", tab( N ). newline --> " ". </pre> ===Utility Predicates=== ====contains_coin( ?Collection, ?Coin )==== holds when <var>Coin</var> is a member of <var>Collection</var>. <pre class="prolog"> contains_coin( Collection, Coin ) :- part( _Part, Collection, Coins ), member( Coin, Coins ). </pre> ====collection_to_set( +Collection, ?Set )==== holds when <var>Set</var> is the distributed union of the <code>known_true</code>, <code>not_heavy</code>, <code>not_light</code> and <code>untested</code> ordsets comprising <var>Collection</var>. <pre class="prolog"> collection_to_set( Collection, Set ) :- part( known_true, Collection, KnownTrue ), part( not_heavy, Collection, NotHeavy ), part( not_light, Collection, NotLight ), part( untested, Collection, Untested ), ord_union( [KnownTrue,NotHeavy,NotLight,Untested], Set ). </pre> ===Information Content=== ==== information_content( +Counts, ?Content ) ==== holds when <var>Content</var> is the cumulative negative entropy of <var>Counts</var>. A reduction in entropy equates to a gain in information. <pre class="prolog"> information_content( Counts, Content ) :- information_content1( Counts, 0, Content ). information_content1( [], Content, Content ). information_content1( [Count|Counts], Content0, Content ):- coins_entropy( Count, Entropy ), Content1 is Content0-Entropy, information_content1( Counts, Content1, Content ). </pre> ==== coins_entropy( ?N, ?Entropy ) ==== holds when <var>Entropy</var> estimates the entropy of a sample of <var>N</var> coins. <var>Entropy</var> = P log₂(¹&frasl;_P), where P = <var>N</var>&divide;12. <pre class="prolog"> coins_entropy( 0, 0.0 ). coins_entropy( 1, 0.2987 ). coins_entropy( 2, 0.4308 ). coins_entropy( 3, 0.5 ). coins_entropy( 4, 0.5283 ). coins_entropy( 5, 0.5263 ). coins_entropy( 6, 0.5 ). coins_entropy( 7, 0.4536 ). coins_entropy( 8, 0.39 ). coins_entropy( 9, 0.3113 ). coins_entropy( 10, 0.2192 ). coins_entropy( 11, 0.1151 ). coins_entropy( 12, 0.0 ). </pre> ====select_coins( +Part, +Coins, ?Sample, ?Residue, ?N )==== holds when <var>N</var> coins from <var>Part</var> of <var>Coins</var> form <var>Part</var> of <var>Sample</var>, with the remainder forming <var>Part</var> of <var>Residue</var>. <pre class="prolog"> select_coins( Part, Coins, Sample, Residue, Count ) :- part( Part, Coins, Input ), part( Part, Sample, Selection ), part( Part, Residue, Remainder ), select_n( Count, Input, Selection, Remainder ). select_n( 0, In, [], In ). select_n( 1, [A|Suffix], [A], Suffix ). select_n( 2, [A,B|Suffix], [A,B], Suffix ). select_n( 3, [A,B,C|Suffix], [A,B,C], Suffix ). select_n( 4, [A,B,C,D|Suffix], [A,B,C,D], Suffix ). select_n( 5, [A,B,C,D,E|Suffix], [A,B,C,D,E], Suffix ). select_n( 6, [A,B,C,D,E,F|Suffix], [A,B,C,D,E,F], Suffix ). </pre> Load a small library of [[Puzzle Utilities]]. <pre class="prolog"> :- ensure_loaded( misc ). </pre> Use the ordsets library. <pre class="prolog"> :- use_module( library(ordsets), [ord_union/2,ord_union/3] ). </pre> The code is available as plain text [https://binding-time.co.uk/download/counterfeit.txt here]. ==Output== <div class="result"> Number the coins 1..12 BEGIN Put the coins numbered 1, 2, 3 and 4 on the left-hand pan Put the coins numbered 5, 6, 7 and 8 on the right-hand pan Leaving the coins numbered 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 1, 2, 5 and 6 on the left-hand pan Put the coins numbered 3, 7, 9 and 10 on the right-hand pan Leaving the coins numbered 4, 8, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 1 and 7 on the left-hand pan Put the coins numbered 3 and 4 on the right-hand pan Leaving the coins numbered 2, 5, 6, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 1, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 7, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 2, which is light END If the left-hand pan is heavier then: BEGIN Put the coins numbered 3 and 5 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 4, 6, 7, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 3, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 5, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 6, which is heavy END If the pans balance then: BEGIN Put the coins numbered 4 and 8 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 3, 5, 6, 7, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 4, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 8, which is heavy END END If the left-hand pan is heavier then: BEGIN Put the coins numbered 1, 2, 5 and 6 on the left-hand pan Put the coins numbered 3, 7, 9 and 10 on the right-hand pan Leaving the coins numbered 4, 8, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 3 and 5 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 4, 6, 7, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 5, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 3, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 6, which is light END If the left-hand pan is heavier then: BEGIN Put the coins numbered 1 and 7 on the left-hand pan Put the coins numbered 3 and 4 on the right-hand pan Leaving the coins numbered 2, 5, 6, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 7, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 1, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 2, which is heavy END If the pans balance then: BEGIN Put the coins numbered 4 and 8 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 3, 5, 6, 7, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 8, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 4, which is heavy END END If the pans balance then: BEGIN Put the coins numbered 9, 10 and 11 on the left-hand pan Put the coins numbered 1, 2 and 3 on the right-hand pan Leaving the coins numbered 4, 5, 6, 7, 8 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coin numbered 9 on the left-hand pan Put the coin numbered 10 on the right-hand pan Leaving the coins numbered 1, 2, 3, 4, 5, 6, 7, 8, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 9, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 10, which is light If the pans balance then: Conclude that the counterfeit coin is number 11, which is light END If the left-hand pan is heavier then: BEGIN Put the coin numbered 9 on the left-hand pan Put the coin numbered 10 on the right-hand pan Leaving the coins numbered 1, 2, 3, 4, 5, 6, 7, 8, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 10, which is heavy If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 9, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 11, which is heavy END If the pans balance then: BEGIN Put the coin numbered 12 on the left-hand pan Put the coin numbered 1 on the right-hand pan Leaving the coins numbered 2, 3, 4, 5, 6, 7, 8, 9, 10 and 11 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 12, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 12, which is heavy END END END </div> ---- 4f2f800f25baed3a519db3bb4d64b221f43cb4f9 171 170 2017-01-05T20:52:02Z John 2 /* select_coins( +Part, +Coins, ?Sample, ?Residue, ?N ) */ wikitext text/x-wiki __NOTOC__ ==Problem Definition== We are given 12 apparently identical coins - one of which is counterfeit. We know that the counterfeit has a different weight from the others, but we don't know if it's heavier or lighter. ===Task:=== Devise a procedure to identify any counterfeit coin using a balance to take up to three comparative weighings. ==Strategy== The information from three suitable weighings will make all but one of the coins, which are untested initially, known_true. There are three alternative deductions that make a coin known_true: * if it is not_heavy and not_light &ndash; having been on both the comparatively lighter and heavier sides of imbalances; * if it was excluded from an imbalance; * if it was included in a balanced weighing. After three weighings there must be exactly one coin, the counterfeit, which is not known_true. If the counterfeit is not known_true and not_heavy we deduce that it must be light. If it is not known_true and not_light, it must be heavy. We use a generate-and-test method as follows: * Create the set of all possible counterfeits: 12 coins &times; 2 weights ; * Devise a procedure that can identify the first counterfeit coin; * Show that the same procedure works for every other counterfeit coin. ==Entry Point== ====go==== is the entry point. It solves the puzzle, then uses a DCG to pretty-print the resulting procedure. <pre class="prolog"> go :- coins_puzzle( Procedure ), phrase( general_explanation( Procedure ), Chars ), put_chars( Chars ). </pre> ====coins_puzzle( ?Procedure )==== generates the set of all possible counterfeit coins and finds, or proves, that <var>Procedure</var> can identify them all. <pre class="prolog"> coins_puzzle( Procedure ) :- coins( Coins ), counterfeit( Counterfeit, Coin, Weight ), findall( Counterfeit, (member(Coin,Coins), counterfeit_weight(Weight)), Counterfeits ), coins_puzzle_solution( Counterfeits, Procedure ). coins_puzzle_solution( [], _Procedure ). coins_puzzle_solution( [Counterfeit|Counterfeits], Procedure ) :- solve_coins( Counterfeit, Procedure ), coins_puzzle_solution( Counterfeits, Procedure ). </pre> A procedure is either &lsquo;done&rsquo;, identifying a particular coin and whether it is heavy or light; or it is a &lsquo;step&rsquo;. A step defines the coins to be placed on the <var>Left</var> and <var>Right</var> pans, with the residue remaining on the <var>Table</var>, and three <var>Branches</var>, one of which will be chosen depending on the outcome of the weighing. <pre class="prolog"> step( step(Left,Right,Table,Branches), Left, Right, Table, Branches). </pre> The <var>Branches</var> are three procedures equating to: * > (left pan heavier), * < (right pan heavier) and * <nowiki>= (pans balance).</nowiki> <pre class="prolog"> branch( >, branches(_Equal, GT, _LT), GT ). branch( <, branches(_Equal, _GT, LT), LT ). branch( =, branches(Equal, _GT, _LT), Equal ). </pre> The counterfeit is defined by its number and whether it is heavy or light. <pre class="prolog"> counterfeit( counterfeit(Coin, HeavyOrLight), Coin, HeavyOrLight ). coins( [1,2,3,4,5,6,7,8,9,10,11,12] ). counterfeit_weight( heavy ). counterfeit_weight( light ). </pre> A &lsquo;coin collection&rsquo; comprises four &lsquo;parts&rsquo; (subsets): the <code>known_true</code>, <code>not_heavy</code>, <code>not_light</code> and <code>untested</code> sets of coins. <pre class="prolog"> part( known_true, collection(Coins,_,_,_), Coins ). part( not_heavy, collection(_,Coins,_,_), Coins ). part( not_light, collection(_,_,Coins,_), Coins ). part( untested, collection(_,_,_,Coins), Coins ). </pre> ==Solution== ====solve_coins( +Counterfeit, ?Procedure )==== holds when <var>Procedure</var> can correctly identify the <var>Counterfeit</var> coin. Beginning with a &lsquo;start&rsquo; collection, in which all the coins are untested, the <var>Procedure</var> comprises three &lsquo;steps&rsquo;. For each step, a weighing is made and a &lsquo;branch&rsquo; is made in the <var>Procedure</var>, depending on the result of the weighing. After three steps, the <var>Procedure</var> must have reached the &lsquo;end&rsquo; condition. Finally, an assertion (redundant test) ensures that the <var>Procedure</var> has found the correct end condition. <pre class="prolog"> solve_coins( Counterfeit, Procedure ) :- start( Coins0 ), assay( Counterfeit, Coins0, Procedure, Branch1, Coins1 ), assay( Counterfeit, Coins1, Branch1, Branch2, Coins2 ), assay( Counterfeit, Coins2, Branch2, done(Coin, HeavyOrLight), Coins3 ), end( Coins3, Coin, HeavyOrLight ), counterfeit( Counterfeit, Coin, HeavyOrLight ). start( Coins ) :- coins( Untested ), part( untested, Coins, Untested ), part( not_heavy, Coins, [] ), part( not_light, Coins, [] ), part( known_true, Coins, [] ). end( Coins, Coin, HeavyOrLight ) :- part( untested, Coins, [] ), part( not_heavy, Coins, Light ), part( not_light, Coins, Heavy ), end_result( Heavy, Light, Coin, HeavyOrLight ). end_result( [Coin], [], Coin, heavy ). end_result( [], [Coin], Coin, light ). </pre> === Simulating the weighing process === ====assay( +Counterfeit, +Coins0, ?Step, ?Branch, ?Coins1 )==== holds when the appropriate <var>Branch</var> from <var>Step</var> is chosen by comparing the weights of two coin collections taken from the full set of coins: <var>Coins0</var>. <var>Coins1</var> is the full set of coins, updated with the inferences drawn from the weighing. <var>Counterfeit</var> is used to determine the result of the weighing. This predicate applies the critical insight into the solution of this puzzle: we have 24 (12 &times; 2) possible inputs to the procedure, with only 27 (3 &times; 3 &times; 3) possible outcomes from the weighings. Therefore, it is clear that each weighing must have a very high [[#Information Content|information content]]. Choosing which weighing to make by estimating the available information content makes the problem tractable. <pre class="prolog"> assay( Counterfeit, Coins0, Step, Branch, Coins ) :- WeighingDatum = weighing_data(InfoContent, Left, Right, Table), step( Step, Left, Right, Table, Branches ), findall( WeighingDatum, valid_partition( Coins0, InfoContent, Left, Right, Table ), WeighingData ), sort( WeighingData, OrderedWeighingData ), member( WeighingDatum, OrderedWeighingData ), balance( Left, Right, Counterfeit, Result ), draw_inferences( Result, Left, Right, Table, Coins ), branch( Result, Branches, Branch ). </pre> ====balance( +Left, +Right, +Counterfeit, ?Result )==== holds when <var>Result</var> simulates the outcome of testing the coin collections <var>Left</var> and <var>Right</var> with a balance, where either may contain the <var>Counterfeit</var> coin. <pre class="prolog"> balance( Left, Right, Counterfeit, Result ):- counterfeit( Counterfeit, Coin, Weight ), ( contains_coin( Left, Coin ) -> balance_result( Weight, normal, Result ) ; contains_coin( Right, Coin ) -> balance_result( normal, Weight, Result ) ; otherwise -> Result = '=' ). balance_result( light, normal, < ). balance_result( heavy, normal, > ). balance_result( normal, heavy, < ). balance_result( normal, light, > ). </pre> ===Choosing which coins to weigh=== ====valid_partition( +Coins, ?Content, ?Left, ?Right, ?Table )==== holds when <var>Coins</var> can be partitioned into three collections: <var>Left</var> side, <var>Right</var> side and <var>Table</var>; with the information content of the partition given by <var>Content</var>. The definition of a valid_partition ensures that: * <var>Left</var> and <var>Right</var> must have the same number of coins (at least one); * <var>Left</var> cannot contain any known_true coins, because adding true coins to both sides creates redundant comparisons; * Comparisons between mixtures of coins where only the choice of pans is different are equivalent; so a partial order (&ge;) on mixtures of coins is used to eliminate some redundant comparisons. <pre class="prolog"> valid_partition( Coins, Content, Left, Right, Table ):- part( known_true, Left, [] ), selection( Coins, Left, Coins1, LeftSum, LeftInfo ), selection( Coins1, Right, Table, RightSum, RightInfo ), LeftSum =:= RightSum, LeftSum @>= RightSum, table_information( Table, TableInfo ), sum( [LeftInfo,RightInfo,TableInfo], Content ). </pre> ====selection( +Coins, ?Sample, ?Residue, ?Sum, ?Content )==== holds when <var>Coins</var> is partitioned into two collections: <var>Sample</var> and <var>Residue</var>. <var>Sum</var> is used as both a fingerprint for the mixture of coins in <var>Sample</var> and a representation of the number of coins in <var>Sample</var>. <var>Content</var> estimates the information-content of <var>Sample</var>. <pre class="prolog"> selection( Coins, Sample, Residue, Sum, Content ) :- Sum = Count1+Count2+Count3+Count4, select_coins( not_heavy, Coins, Sample, Residue, Count1 ), select_coins( not_light, Coins, Sample, Residue, Count2 ), select_coins( untested, Coins, Sample, Residue, Count3 ), select_coins( known_true, Coins, Sample, Residue, Count4 ), Sum >= 1, Sum =< 6, information_content( [Count1,Count2,Count3,Count4], Content ). </pre> ====table_information( +Coins, ?Content )==== holds when <var>Coins</var> has 'information content' <var>Content</var>. <pre class="prolog"> table_information( Coins, Content ) :- count_coins( not_heavy, Coins, Count1 ), count_coins( not_light, Coins, Count2 ), count_coins( untested, Coins, Count3 ), count_coins( known_true, Coins, Count4 ), information_content( [Count1,Count2,Count3,Count4], Content ). count_coins( Part, Coins, Count ) :- part( Part, Coins, Selection ), length( Selection, Count ). </pre> === Updating what is known about the coins === ====draw_inferences( +Result, +Left, +Right, +Table, ?Coins )==== holds when <var>Result</var> is one of: * > (imbalance &ndash; left pan heavier), * < (imbalance &ndash; right pan heavier) or * <nowiki>=</nowiki> (pans balanced) from taking a weighing with the coin collections: <var>Left</var>, <var>Right</var> and <var>Table</var>. <var>Coins</var> is derived from this information using the following rules: * If the pans are unbalanced then only the previously untested or not_heavy coins on the lighter side of the balance are now not_heavy. Similarly, only the previously untested or not_light coins on the heavier side of the balance are now not_light. All the coins on the table are now known_true. * If the pans balance then all the coins weighed are known_true, with the coins on the <var>Table</var> left in their prior states. <pre class="prolog"> draw_inferences( <, Left, Right, Table, Coins ) :- imbalance_inferences( Left, Right, Table, Coins ). draw_inferences( >, Left, Right, Table, Coins ) :- imbalance_inferences( Right, Left, Table, Coins ). draw_inferences( =, Left, Right, Table, Coins ) :- becomes( [all(Left),known_true(Table),all(Right)], known_true( Coins ) ), becomes( untested(Table), untested(Coins) ), becomes( not_heavy(Table), not_heavy(Coins) ), becomes( not_light(Table), not_light(Coins) ). </pre> ====imbalance_inferences( +Lighter, +Heavier, +Table, ?Coins )==== holds when: * Only the untested or not_heavy coins in <var>Lighter</var> are not_heavy in <var>Coins</var>; * Only the untested or not_light coins in <var>Heavier</var> are not_light in <var>Coins</var>; * All the other coins in <var>Lighter</var> and <var>Heavier</var> and all the coins in <var>Table</var> are known_true in <var>Coins</var>; There are no untested coins in <var>Coins</var>. <pre class="prolog"> imbalance_inferences( Lighter, Heavier, Table, Coins ) :- becomes( [untested(Lighter),not_heavy(Lighter)], not_heavy(Coins) ), becomes( [untested(Heavier),not_light(Heavier)], not_light(Coins) ), becomes( [ known_true(Lighter), not_light(Lighter), known_true(Heavier), not_heavy(Heavier), all(Table) ], known_true(Coins) ), part( untested, Coins, [] ). </pre> ====becomes( +CollectionA, ?CollectionB )==== <var>CollectionA</var> becomes (part) <var>CollectionB</var> when <var>CollectionB</var> comprises the same coins as <var>CollectionA</var>. <pre class="prolog"> becomes( CollectionA, CollectionB ) :- unfolded( CollectionA, Coins ), unfolded( CollectionB, Coins ). </pre> ====unfolded( +Collection, ?Coins )==== holds when (part) <var>Collection</var> comprises <var>Coins</var>. <pre class="prolog"> unfolded( not_light(Collection), Coins ) :- part( not_light, Collection, Coins ). unfolded( not_heavy(Collection), Coins ) :- part( not_heavy, Collection, Coins ). unfolded( known_true(Collection), Coins ) :- part( known_true, Collection, Coins ). unfolded( untested(Collection), Coins ) :- part( untested, Collection, Coins ). unfolded( all(Collection), Coins ) :- collection_to_set( Collection, Coins ). unfolded( [Item|Items], Coins ) :- unfolded( Item, Value ), unfolded1( Items, Value, Coins ). unfolded1( [], Coins, Coins ). unfolded1( [Item|Items], Value, Coins ) :- unfolded( Item, Value0 ), ord_union( Value0, Value, Value1 ), unfolded1( Items, Value1, Coins ). </pre> ==Definite Clause Grammar== The following DCG represents the method for finding the counterfeit coin as a structured procedure. <pre class="prolog"> general_explanation( Procedure ) --> "Number the coins 1..12", newline, explanation( Procedure, 0 ). explanation( done(Coin, Weight), N ) --> tab( N ), "Conclude that the counterfeit coin is number ", literal( Coin ), ", which is ", literal( Weight ), newline. explanation( Step, N ) --> {step( Step, Left, Right, Table, Branches )}, tab( N ), "BEGIN", newline, tab( N ), "Put ", literal( Left ), " on the left-hand pan", newline, tab( N ), "Put ", literal( Right ), " on the right-hand pan", newline, tab( N ), "Leaving ", literal( Table ), " on the table", newline, branches_explained( Branches, N ), tab( N ), "END", newline. branches_explained( Branches, N ) --> next_step_explained( <, Branches, N ), next_step_explained( >, Branches, N ), next_step_explained( =, Branches, N ). next_step_explained( Result, Branch, N ) --> {branch( Result, Branch, Step )}, ( {var(Step)} -> "" | {nonvar(Step)} -> tab( N ), "If the ", literal( Result ), " then:", newline, explanation( Step, s(N) ) ). literal( 0 ) --> "0". literal( 1 ) --> "1". literal( 2 ) --> "2". literal( 3 ) --> "3". literal( 4 ) --> "4". literal( 5 ) --> "5". literal( 6 ) --> "6". literal( 7 ) --> "7". literal( 8 ) --> "8". literal( 9 ) --> "9". literal( 10 ) --> "10". literal( 11 ) --> "11". literal( 12 ) --> "12". literal( true ) --> "true". literal( heavy ) --> "heavy". literal( light ) --> "light". literal( = ) --> "pans balance". literal( < ) --> "right-hand pan is heavier". literal( > ) --> "left-hand pan is heavier". literal( Collection ) --> {collection_to_set( Collection , [H|T] )}, literal_set( T, H ). literal_set( [], Number ) --> "the coin numbered ", literal( Number ). literal_set( [H|T], Number ) --> "the coins numbered ", literal( Number ), literal_set1( T, H ). literal_set1( [], Number ) --> " and ", literal( Number ). literal_set1( [H|T], Number ) --> ", ", literal( Number ), literal_set1( T, H ). tab( 0 ) --> "". tab( s(N) ) --> " ", tab( N ). newline --> " ". </pre> ===Utility Predicates=== ====contains_coin( ?Collection, ?Coin )==== holds when <var>Coin</var> is a member of <var>Collection</var>. <pre class="prolog"> contains_coin( Collection, Coin ) :- part( _Part, Collection, Coins ), member( Coin, Coins ). </pre> ====collection_to_set( +Collection, ?Set )==== holds when <var>Set</var> is the distributed union of the <code>known_true</code>, <code>not_heavy</code>, <code>not_light</code> and <code>untested</code> ordsets comprising <var>Collection</var>. <pre class="prolog"> collection_to_set( Collection, Set ) :- part( known_true, Collection, KnownTrue ), part( not_heavy, Collection, NotHeavy ), part( not_light, Collection, NotLight ), part( untested, Collection, Untested ), ord_union( [KnownTrue,NotHeavy,NotLight,Untested], Set ). </pre> ===Information Content=== ==== information_content( +Counts, ?Content ) ==== holds when <var>Content</var> is the cumulative negative entropy of <var>Counts</var>. A reduction in entropy equates to a gain in information. <pre class="prolog"> information_content( Counts, Content ) :- information_content1( Counts, 0, Content ). information_content1( [], Content, Content ). information_content1( [Count|Counts], Content0, Content ):- coins_entropy( Count, Entropy ), Content1 is Content0-Entropy, information_content1( Counts, Content1, Content ). </pre> ==== coins_entropy( ?N, ?Entropy ) ==== holds when <var>Entropy</var> estimates the entropy of a sample of <var>N</var> coins. <var>Entropy</var> = P log₂(¹&frasl;_P), where P = <var>N</var>&divide;12. <pre class="prolog"> coins_entropy( 0, 0.0 ). coins_entropy( 1, 0.2987 ). coins_entropy( 2, 0.4308 ). coins_entropy( 3, 0.5 ). coins_entropy( 4, 0.5283 ). coins_entropy( 5, 0.5263 ). coins_entropy( 6, 0.5 ). coins_entropy( 7, 0.4536 ). coins_entropy( 8, 0.39 ). coins_entropy( 9, 0.3113 ). coins_entropy( 10, 0.2192 ). coins_entropy( 11, 0.1151 ). coins_entropy( 12, 0.0 ). </pre> ====select_coins( +Part, +Coins, ?Sample, ?Residue, ?N )==== holds when <var>N</var> coins from <var>Part</var> of <var>Coins</var> form <var>Part</var> of <var>Sample</var>, with the remainder forming <var>Part</var> of <var>Residue</var>. <pre class="prolog"> select_coins( Part, Coins, Sample, Residue, Count ) :- part( Part, Coins, Input ), part( Part, Sample, Selection ), part( Part, Residue, Remainder ), select_n( Count, Input, Selection, Remainder ). select_n( 0, In, [], In ). select_n( 1, [A|Suffix], [A], Suffix ). select_n( 2, [A,B|Suffix], [A,B], Suffix ). select_n( 3, [A,B,C|Suffix], [A,B,C], Suffix ). select_n( 4, [A,B,C,D|Suffix], [A,B,C,D], Suffix ). select_n( 5, [A,B,C,D,E|Suffix], [A,B,C,D,E], Suffix ). select_n( 6, [A,B,C,D,E,F|Suffix], [A,B,C,D,E,F], Suffix ). </pre> Load a small library of [[Puzzle Utilities]]. <pre class="prolog"> :- ensure_loaded( misc ). </pre> Use the ordsets library. <pre class="prolog"> :- use_module( library(ordsets), [ord_union/2,ord_union/3] ). </pre> The code is available as plain text [https://binding-time.co.uk/download/counterfeit.txt here]. ==Output== <div class="result"> Number the coins 1..12 BEGIN Put the coins numbered 1, 2, 3 and 4 on the left-hand pan Put the coins numbered 5, 6, 7 and 8 on the right-hand pan Leaving the coins numbered 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 1, 2, 5 and 6 on the left-hand pan Put the coins numbered 3, 7, 9 and 10 on the right-hand pan Leaving the coins numbered 4, 8, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 1 and 7 on the left-hand pan Put the coins numbered 3 and 4 on the right-hand pan Leaving the coins numbered 2, 5, 6, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 1, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 7, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 2, which is light END If the left-hand pan is heavier then: BEGIN Put the coins numbered 3 and 5 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 4, 6, 7, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 3, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 5, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 6, which is heavy END If the pans balance then: BEGIN Put the coins numbered 4 and 8 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 3, 5, 6, 7, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 4, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 8, which is heavy END END If the left-hand pan is heavier then: BEGIN Put the coins numbered 1, 2, 5 and 6 on the left-hand pan Put the coins numbered 3, 7, 9 and 10 on the right-hand pan Leaving the coins numbered 4, 8, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 3 and 5 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 4, 6, 7, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 5, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 3, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 6, which is light END If the left-hand pan is heavier then: BEGIN Put the coins numbered 1 and 7 on the left-hand pan Put the coins numbered 3 and 4 on the right-hand pan Leaving the coins numbered 2, 5, 6, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 7, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 1, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 2, which is heavy END If the pans balance then: BEGIN Put the coins numbered 4 and 8 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 3, 5, 6, 7, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 8, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 4, which is heavy END END If the pans balance then: BEGIN Put the coins numbered 9, 10 and 11 on the left-hand pan Put the coins numbered 1, 2 and 3 on the right-hand pan Leaving the coins numbered 4, 5, 6, 7, 8 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coin numbered 9 on the left-hand pan Put the coin numbered 10 on the right-hand pan Leaving the coins numbered 1, 2, 3, 4, 5, 6, 7, 8, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 9, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 10, which is light If the pans balance then: Conclude that the counterfeit coin is number 11, which is light END If the left-hand pan is heavier then: BEGIN Put the coin numbered 9 on the left-hand pan Put the coin numbered 10 on the right-hand pan Leaving the coins numbered 1, 2, 3, 4, 5, 6, 7, 8, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 10, which is heavy If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 9, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 11, which is heavy END If the pans balance then: BEGIN Put the coin numbered 12 on the left-hand pan Put the coin numbered 1 on the right-hand pan Leaving the coins numbered 2, 3, 4, 5, 6, 7, 8, 9, 10 and 11 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 12, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 12, which is heavy END END END </div> ---- 4cb8477bffdacf00cc5ca62f3d3cca172c208f18 182 171 2017-01-24T16:08:01Z John 2 /* assay( +Counterfeit, +Coins0, ?Step, ?Branch, ?Coins1 ) */ wikitext text/x-wiki __NOTOC__ ==Problem Definition== We are given 12 apparently identical coins - one of which is counterfeit. We know that the counterfeit has a different weight from the others, but we don't know if it's heavier or lighter. ===Task:=== Devise a procedure to identify any counterfeit coin using a balance to take up to three comparative weighings. ==Strategy== The information from three suitable weighings will make all but one of the coins, which are untested initially, known_true. There are three alternative deductions that make a coin known_true: * if it is not_heavy and not_light &ndash; having been on both the comparatively lighter and heavier sides of imbalances; * if it was excluded from an imbalance; * if it was included in a balanced weighing. After three weighings there must be exactly one coin, the counterfeit, which is not known_true. If the counterfeit is not known_true and not_heavy we deduce that it must be light. If it is not known_true and not_light, it must be heavy. We use a generate-and-test method as follows: * Create the set of all possible counterfeits: 12 coins &times; 2 weights ; * Devise a procedure that can identify the first counterfeit coin; * Show that the same procedure works for every other counterfeit coin. ==Entry Point== ====go==== is the entry point. It solves the puzzle, then uses a DCG to pretty-print the resulting procedure. <pre class="prolog"> go :- coins_puzzle( Procedure ), phrase( general_explanation( Procedure ), Chars ), put_chars( Chars ). </pre> ====coins_puzzle( ?Procedure )==== generates the set of all possible counterfeit coins and finds, or proves, that <var>Procedure</var> can identify them all. <pre class="prolog"> coins_puzzle( Procedure ) :- coins( Coins ), counterfeit( Counterfeit, Coin, Weight ), findall( Counterfeit, (member(Coin,Coins), counterfeit_weight(Weight)), Counterfeits ), coins_puzzle_solution( Counterfeits, Procedure ). coins_puzzle_solution( [], _Procedure ). coins_puzzle_solution( [Counterfeit|Counterfeits], Procedure ) :- solve_coins( Counterfeit, Procedure ), coins_puzzle_solution( Counterfeits, Procedure ). </pre> A procedure is either &lsquo;done&rsquo;, identifying a particular coin and whether it is heavy or light; or it is a &lsquo;step&rsquo;. A step defines the coins to be placed on the <var>Left</var> and <var>Right</var> pans, with the residue remaining on the <var>Table</var>, and three <var>Branches</var>, one of which will be chosen depending on the outcome of the weighing. <pre class="prolog"> step( step(Left,Right,Table,Branches), Left, Right, Table, Branches). </pre> The <var>Branches</var> are three procedures equating to: * > (left pan heavier), * < (right pan heavier) and * <nowiki>= (pans balance).</nowiki> <pre class="prolog"> branch( >, branches(_Equal, GT, _LT), GT ). branch( <, branches(_Equal, _GT, LT), LT ). branch( =, branches(Equal, _GT, _LT), Equal ). </pre> The counterfeit is defined by its number and whether it is heavy or light. <pre class="prolog"> counterfeit( counterfeit(Coin, HeavyOrLight), Coin, HeavyOrLight ). coins( [1,2,3,4,5,6,7,8,9,10,11,12] ). counterfeit_weight( heavy ). counterfeit_weight( light ). </pre> A &lsquo;coin collection&rsquo; comprises four &lsquo;parts&rsquo; (subsets): the <code>known_true</code>, <code>not_heavy</code>, <code>not_light</code> and <code>untested</code> sets of coins. <pre class="prolog"> part( known_true, collection(Coins,_,_,_), Coins ). part( not_heavy, collection(_,Coins,_,_), Coins ). part( not_light, collection(_,_,Coins,_), Coins ). part( untested, collection(_,_,_,Coins), Coins ). </pre> ==Solution== ====solve_coins( +Counterfeit, ?Procedure )==== holds when <var>Procedure</var> can correctly identify the <var>Counterfeit</var> coin. Beginning with a &lsquo;start&rsquo; collection, in which all the coins are untested, the <var>Procedure</var> comprises three &lsquo;steps&rsquo;. For each step, a weighing is made and a &lsquo;branch&rsquo; is made in the <var>Procedure</var>, depending on the result of the weighing. After three steps, the <var>Procedure</var> must have reached the &lsquo;end&rsquo; condition. Finally, an assertion (redundant test) ensures that the <var>Procedure</var> has found the correct end condition. <pre class="prolog"> solve_coins( Counterfeit, Procedure ) :- start( Coins0 ), assay( Counterfeit, Coins0, Procedure, Branch1, Coins1 ), assay( Counterfeit, Coins1, Branch1, Branch2, Coins2 ), assay( Counterfeit, Coins2, Branch2, done(Coin, HeavyOrLight), Coins3 ), end( Coins3, Coin, HeavyOrLight ), counterfeit( Counterfeit, Coin, HeavyOrLight ). start( Coins ) :- coins( Untested ), part( untested, Coins, Untested ), part( not_heavy, Coins, [] ), part( not_light, Coins, [] ), part( known_true, Coins, [] ). end( Coins, Coin, HeavyOrLight ) :- part( untested, Coins, [] ), part( not_heavy, Coins, Light ), part( not_light, Coins, Heavy ), end_result( Heavy, Light, Coin, HeavyOrLight ). end_result( [Coin], [], Coin, heavy ). end_result( [], [Coin], Coin, light ). </pre> === Simulating the weighing process === ====assay( +Counterfeit, +Coins0, ?Step, ?Branch, ?Coins1 )==== holds when the appropriate <var>Branch</var> from <var>Step</var> is chosen by comparing the weights of two coin collections taken from the full set of coins: <var>Coins0</var>. <var>Coins1</var> is the full set of coins updated with the inferences drawn from the weighing, where <var>Counterfeit</var> is used to determine the result of the weighing. This predicate applies the critical insight into the solution of this puzzle: we have 24 (12 &times; 2) possible inputs to the procedure, with only 27 (3 &times; 3 &times; 3) possible outcomes from the weighings. Therefore, it is clear that each weighing must have a very high [[#Information Content|information content]]. Choosing which weighing to make by estimating the available information content makes the problem tractable. <pre class="prolog"> assay( Counterfeit, Coins0, Step, Branch, Coins ) :- WeighingDatum = weighing_data(InfoContent, Left, Right, Table), step( Step, Left, Right, Table, Branches ), findall( WeighingDatum, valid_partition( Coins0, InfoContent, Left, Right, Table ), WeighingData ), sort( WeighingData, OrderedWeighingData ), member( WeighingDatum, OrderedWeighingData ), balance( Left, Right, Counterfeit, Result ), draw_inferences( Result, Left, Right, Table, Coins ), branch( Result, Branches, Branch ). </pre> ====balance( +Left, +Right, +Counterfeit, ?Result )==== holds when <var>Result</var> simulates the outcome of testing the coin collections <var>Left</var> and <var>Right</var> with a balance, where either may contain the <var>Counterfeit</var> coin. <pre class="prolog"> balance( Left, Right, Counterfeit, Result ):- counterfeit( Counterfeit, Coin, Weight ), ( contains_coin( Left, Coin ) -> balance_result( Weight, normal, Result ) ; contains_coin( Right, Coin ) -> balance_result( normal, Weight, Result ) ; otherwise -> Result = '=' ). balance_result( light, normal, < ). balance_result( heavy, normal, > ). balance_result( normal, heavy, < ). balance_result( normal, light, > ). </pre> ===Choosing which coins to weigh=== ====valid_partition( +Coins, ?Content, ?Left, ?Right, ?Table )==== holds when <var>Coins</var> can be partitioned into three collections: <var>Left</var> side, <var>Right</var> side and <var>Table</var>; with the information content of the partition given by <var>Content</var>. The definition of a valid_partition ensures that: * <var>Left</var> and <var>Right</var> must have the same number of coins (at least one); * <var>Left</var> cannot contain any known_true coins, because adding true coins to both sides creates redundant comparisons; * Comparisons between mixtures of coins where only the choice of pans is different are equivalent; so a partial order (&ge;) on mixtures of coins is used to eliminate some redundant comparisons. <pre class="prolog"> valid_partition( Coins, Content, Left, Right, Table ):- part( known_true, Left, [] ), selection( Coins, Left, Coins1, LeftSum, LeftInfo ), selection( Coins1, Right, Table, RightSum, RightInfo ), LeftSum =:= RightSum, LeftSum @>= RightSum, table_information( Table, TableInfo ), sum( [LeftInfo,RightInfo,TableInfo], Content ). </pre> ====selection( +Coins, ?Sample, ?Residue, ?Sum, ?Content )==== holds when <var>Coins</var> is partitioned into two collections: <var>Sample</var> and <var>Residue</var>. <var>Sum</var> is used as both a fingerprint for the mixture of coins in <var>Sample</var> and a representation of the number of coins in <var>Sample</var>. <var>Content</var> estimates the information-content of <var>Sample</var>. <pre class="prolog"> selection( Coins, Sample, Residue, Sum, Content ) :- Sum = Count1+Count2+Count3+Count4, select_coins( not_heavy, Coins, Sample, Residue, Count1 ), select_coins( not_light, Coins, Sample, Residue, Count2 ), select_coins( untested, Coins, Sample, Residue, Count3 ), select_coins( known_true, Coins, Sample, Residue, Count4 ), Sum >= 1, Sum =< 6, information_content( [Count1,Count2,Count3,Count4], Content ). </pre> ====table_information( +Coins, ?Content )==== holds when <var>Coins</var> has 'information content' <var>Content</var>. <pre class="prolog"> table_information( Coins, Content ) :- count_coins( not_heavy, Coins, Count1 ), count_coins( not_light, Coins, Count2 ), count_coins( untested, Coins, Count3 ), count_coins( known_true, Coins, Count4 ), information_content( [Count1,Count2,Count3,Count4], Content ). count_coins( Part, Coins, Count ) :- part( Part, Coins, Selection ), length( Selection, Count ). </pre> === Updating what is known about the coins === ====draw_inferences( +Result, +Left, +Right, +Table, ?Coins )==== holds when <var>Result</var> is one of: * > (imbalance &ndash; left pan heavier), * < (imbalance &ndash; right pan heavier) or * <nowiki>=</nowiki> (pans balanced) from taking a weighing with the coin collections: <var>Left</var>, <var>Right</var> and <var>Table</var>. <var>Coins</var> is derived from this information using the following rules: * If the pans are unbalanced then only the previously untested or not_heavy coins on the lighter side of the balance are now not_heavy. Similarly, only the previously untested or not_light coins on the heavier side of the balance are now not_light. All the coins on the table are now known_true. * If the pans balance then all the coins weighed are known_true, with the coins on the <var>Table</var> left in their prior states. <pre class="prolog"> draw_inferences( <, Left, Right, Table, Coins ) :- imbalance_inferences( Left, Right, Table, Coins ). draw_inferences( >, Left, Right, Table, Coins ) :- imbalance_inferences( Right, Left, Table, Coins ). draw_inferences( =, Left, Right, Table, Coins ) :- becomes( [all(Left),known_true(Table),all(Right)], known_true( Coins ) ), becomes( untested(Table), untested(Coins) ), becomes( not_heavy(Table), not_heavy(Coins) ), becomes( not_light(Table), not_light(Coins) ). </pre> ====imbalance_inferences( +Lighter, +Heavier, +Table, ?Coins )==== holds when: * Only the untested or not_heavy coins in <var>Lighter</var> are not_heavy in <var>Coins</var>; * Only the untested or not_light coins in <var>Heavier</var> are not_light in <var>Coins</var>; * All the other coins in <var>Lighter</var> and <var>Heavier</var> and all the coins in <var>Table</var> are known_true in <var>Coins</var>; There are no untested coins in <var>Coins</var>. <pre class="prolog"> imbalance_inferences( Lighter, Heavier, Table, Coins ) :- becomes( [untested(Lighter),not_heavy(Lighter)], not_heavy(Coins) ), becomes( [untested(Heavier),not_light(Heavier)], not_light(Coins) ), becomes( [ known_true(Lighter), not_light(Lighter), known_true(Heavier), not_heavy(Heavier), all(Table) ], known_true(Coins) ), part( untested, Coins, [] ). </pre> ====becomes( +CollectionA, ?CollectionB )==== <var>CollectionA</var> becomes (part) <var>CollectionB</var> when <var>CollectionB</var> comprises the same coins as <var>CollectionA</var>. <pre class="prolog"> becomes( CollectionA, CollectionB ) :- unfolded( CollectionA, Coins ), unfolded( CollectionB, Coins ). </pre> ====unfolded( +Collection, ?Coins )==== holds when (part) <var>Collection</var> comprises <var>Coins</var>. <pre class="prolog"> unfolded( not_light(Collection), Coins ) :- part( not_light, Collection, Coins ). unfolded( not_heavy(Collection), Coins ) :- part( not_heavy, Collection, Coins ). unfolded( known_true(Collection), Coins ) :- part( known_true, Collection, Coins ). unfolded( untested(Collection), Coins ) :- part( untested, Collection, Coins ). unfolded( all(Collection), Coins ) :- collection_to_set( Collection, Coins ). unfolded( [Item|Items], Coins ) :- unfolded( Item, Value ), unfolded1( Items, Value, Coins ). unfolded1( [], Coins, Coins ). unfolded1( [Item|Items], Value, Coins ) :- unfolded( Item, Value0 ), ord_union( Value0, Value, Value1 ), unfolded1( Items, Value1, Coins ). </pre> ==Definite Clause Grammar== The following DCG represents the method for finding the counterfeit coin as a structured procedure. <pre class="prolog"> general_explanation( Procedure ) --> "Number the coins 1..12", newline, explanation( Procedure, 0 ). explanation( done(Coin, Weight), N ) --> tab( N ), "Conclude that the counterfeit coin is number ", literal( Coin ), ", which is ", literal( Weight ), newline. explanation( Step, N ) --> {step( Step, Left, Right, Table, Branches )}, tab( N ), "BEGIN", newline, tab( N ), "Put ", literal( Left ), " on the left-hand pan", newline, tab( N ), "Put ", literal( Right ), " on the right-hand pan", newline, tab( N ), "Leaving ", literal( Table ), " on the table", newline, branches_explained( Branches, N ), tab( N ), "END", newline. branches_explained( Branches, N ) --> next_step_explained( <, Branches, N ), next_step_explained( >, Branches, N ), next_step_explained( =, Branches, N ). next_step_explained( Result, Branch, N ) --> {branch( Result, Branch, Step )}, ( {var(Step)} -> "" | {nonvar(Step)} -> tab( N ), "If the ", literal( Result ), " then:", newline, explanation( Step, s(N) ) ). literal( 0 ) --> "0". literal( 1 ) --> "1". literal( 2 ) --> "2". literal( 3 ) --> "3". literal( 4 ) --> "4". literal( 5 ) --> "5". literal( 6 ) --> "6". literal( 7 ) --> "7". literal( 8 ) --> "8". literal( 9 ) --> "9". literal( 10 ) --> "10". literal( 11 ) --> "11". literal( 12 ) --> "12". literal( true ) --> "true". literal( heavy ) --> "heavy". literal( light ) --> "light". literal( = ) --> "pans balance". literal( < ) --> "right-hand pan is heavier". literal( > ) --> "left-hand pan is heavier". literal( Collection ) --> {collection_to_set( Collection , [H|T] )}, literal_set( T, H ). literal_set( [], Number ) --> "the coin numbered ", literal( Number ). literal_set( [H|T], Number ) --> "the coins numbered ", literal( Number ), literal_set1( T, H ). literal_set1( [], Number ) --> " and ", literal( Number ). literal_set1( [H|T], Number ) --> ", ", literal( Number ), literal_set1( T, H ). tab( 0 ) --> "". tab( s(N) ) --> " ", tab( N ). newline --> " ". </pre> ===Utility Predicates=== ====contains_coin( ?Collection, ?Coin )==== holds when <var>Coin</var> is a member of <var>Collection</var>. <pre class="prolog"> contains_coin( Collection, Coin ) :- part( _Part, Collection, Coins ), member( Coin, Coins ). </pre> ====collection_to_set( +Collection, ?Set )==== holds when <var>Set</var> is the distributed union of the <code>known_true</code>, <code>not_heavy</code>, <code>not_light</code> and <code>untested</code> ordsets comprising <var>Collection</var>. <pre class="prolog"> collection_to_set( Collection, Set ) :- part( known_true, Collection, KnownTrue ), part( not_heavy, Collection, NotHeavy ), part( not_light, Collection, NotLight ), part( untested, Collection, Untested ), ord_union( [KnownTrue,NotHeavy,NotLight,Untested], Set ). </pre> ===Information Content=== ==== information_content( +Counts, ?Content ) ==== holds when <var>Content</var> is the cumulative negative entropy of <var>Counts</var>. A reduction in entropy equates to a gain in information. <pre class="prolog"> information_content( Counts, Content ) :- information_content1( Counts, 0, Content ). information_content1( [], Content, Content ). information_content1( [Count|Counts], Content0, Content ):- coins_entropy( Count, Entropy ), Content1 is Content0-Entropy, information_content1( Counts, Content1, Content ). </pre> ==== coins_entropy( ?N, ?Entropy ) ==== holds when <var>Entropy</var> estimates the entropy of a sample of <var>N</var> coins. <var>Entropy</var> = P log₂(¹&frasl;_P), where P = <var>N</var>&divide;12. <pre class="prolog"> coins_entropy( 0, 0.0 ). coins_entropy( 1, 0.2987 ). coins_entropy( 2, 0.4308 ). coins_entropy( 3, 0.5 ). coins_entropy( 4, 0.5283 ). coins_entropy( 5, 0.5263 ). coins_entropy( 6, 0.5 ). coins_entropy( 7, 0.4536 ). coins_entropy( 8, 0.39 ). coins_entropy( 9, 0.3113 ). coins_entropy( 10, 0.2192 ). coins_entropy( 11, 0.1151 ). coins_entropy( 12, 0.0 ). </pre> ====select_coins( +Part, +Coins, ?Sample, ?Residue, ?N )==== holds when <var>N</var> coins from <var>Part</var> of <var>Coins</var> form <var>Part</var> of <var>Sample</var>, with the remainder forming <var>Part</var> of <var>Residue</var>. <pre class="prolog"> select_coins( Part, Coins, Sample, Residue, Count ) :- part( Part, Coins, Input ), part( Part, Sample, Selection ), part( Part, Residue, Remainder ), select_n( Count, Input, Selection, Remainder ). select_n( 0, In, [], In ). select_n( 1, [A|Suffix], [A], Suffix ). select_n( 2, [A,B|Suffix], [A,B], Suffix ). select_n( 3, [A,B,C|Suffix], [A,B,C], Suffix ). select_n( 4, [A,B,C,D|Suffix], [A,B,C,D], Suffix ). select_n( 5, [A,B,C,D,E|Suffix], [A,B,C,D,E], Suffix ). select_n( 6, [A,B,C,D,E,F|Suffix], [A,B,C,D,E,F], Suffix ). </pre> Load a small library of [[Puzzle Utilities]]. <pre class="prolog"> :- ensure_loaded( misc ). </pre> Use the ordsets library. <pre class="prolog"> :- use_module( library(ordsets), [ord_union/2,ord_union/3] ). </pre> The code is available as plain text [https://binding-time.co.uk/download/counterfeit.txt here]. ==Output== <div class="result"> Number the coins 1..12 BEGIN Put the coins numbered 1, 2, 3 and 4 on the left-hand pan Put the coins numbered 5, 6, 7 and 8 on the right-hand pan Leaving the coins numbered 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 1, 2, 5 and 6 on the left-hand pan Put the coins numbered 3, 7, 9 and 10 on the right-hand pan Leaving the coins numbered 4, 8, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 1 and 7 on the left-hand pan Put the coins numbered 3 and 4 on the right-hand pan Leaving the coins numbered 2, 5, 6, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 1, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 7, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 2, which is light END If the left-hand pan is heavier then: BEGIN Put the coins numbered 3 and 5 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 4, 6, 7, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 3, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 5, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 6, which is heavy END If the pans balance then: BEGIN Put the coins numbered 4 and 8 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 3, 5, 6, 7, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 4, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 8, which is heavy END END If the left-hand pan is heavier then: BEGIN Put the coins numbered 1, 2, 5 and 6 on the left-hand pan Put the coins numbered 3, 7, 9 and 10 on the right-hand pan Leaving the coins numbered 4, 8, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 3 and 5 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 4, 6, 7, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 5, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 3, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 6, which is light END If the left-hand pan is heavier then: BEGIN Put the coins numbered 1 and 7 on the left-hand pan Put the coins numbered 3 and 4 on the right-hand pan Leaving the coins numbered 2, 5, 6, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 7, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 1, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 2, which is heavy END If the pans balance then: BEGIN Put the coins numbered 4 and 8 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 3, 5, 6, 7, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 8, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 4, which is heavy END END If the pans balance then: BEGIN Put the coins numbered 9, 10 and 11 on the left-hand pan Put the coins numbered 1, 2 and 3 on the right-hand pan Leaving the coins numbered 4, 5, 6, 7, 8 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coin numbered 9 on the left-hand pan Put the coin numbered 10 on the right-hand pan Leaving the coins numbered 1, 2, 3, 4, 5, 6, 7, 8, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 9, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 10, which is light If the pans balance then: Conclude that the counterfeit coin is number 11, which is light END If the left-hand pan is heavier then: BEGIN Put the coin numbered 9 on the left-hand pan Put the coin numbered 10 on the right-hand pan Leaving the coins numbered 1, 2, 3, 4, 5, 6, 7, 8, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 10, which is heavy If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 9, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 11, which is heavy END If the pans balance then: BEGIN Put the coin numbered 12 on the left-hand pan Put the coin numbered 1 on the right-hand pan Leaving the coins numbered 2, 3, 4, 5, 6, 7, 8, 9, 10 and 11 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 12, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 12, which is heavy END END END </div> ---- e8b4cab3a995fb09d3ecb761a98dce0abf9c4d39 183 182 2017-01-24T16:10:51Z John 2 /* valid_partition( +Coins, ?Content, ?Left, ?Right, ?Table ) */ wikitext text/x-wiki __NOTOC__ ==Problem Definition== We are given 12 apparently identical coins - one of which is counterfeit. We know that the counterfeit has a different weight from the others, but we don't know if it's heavier or lighter. ===Task:=== Devise a procedure to identify any counterfeit coin using a balance to take up to three comparative weighings. ==Strategy== The information from three suitable weighings will make all but one of the coins, which are untested initially, known_true. There are three alternative deductions that make a coin known_true: * if it is not_heavy and not_light &ndash; having been on both the comparatively lighter and heavier sides of imbalances; * if it was excluded from an imbalance; * if it was included in a balanced weighing. After three weighings there must be exactly one coin, the counterfeit, which is not known_true. If the counterfeit is not known_true and not_heavy we deduce that it must be light. If it is not known_true and not_light, it must be heavy. We use a generate-and-test method as follows: * Create the set of all possible counterfeits: 12 coins &times; 2 weights ; * Devise a procedure that can identify the first counterfeit coin; * Show that the same procedure works for every other counterfeit coin. ==Entry Point== ====go==== is the entry point. It solves the puzzle, then uses a DCG to pretty-print the resulting procedure. <pre class="prolog"> go :- coins_puzzle( Procedure ), phrase( general_explanation( Procedure ), Chars ), put_chars( Chars ). </pre> ====coins_puzzle( ?Procedure )==== generates the set of all possible counterfeit coins and finds, or proves, that <var>Procedure</var> can identify them all. <pre class="prolog"> coins_puzzle( Procedure ) :- coins( Coins ), counterfeit( Counterfeit, Coin, Weight ), findall( Counterfeit, (member(Coin,Coins), counterfeit_weight(Weight)), Counterfeits ), coins_puzzle_solution( Counterfeits, Procedure ). coins_puzzle_solution( [], _Procedure ). coins_puzzle_solution( [Counterfeit|Counterfeits], Procedure ) :- solve_coins( Counterfeit, Procedure ), coins_puzzle_solution( Counterfeits, Procedure ). </pre> A procedure is either &lsquo;done&rsquo;, identifying a particular coin and whether it is heavy or light; or it is a &lsquo;step&rsquo;. A step defines the coins to be placed on the <var>Left</var> and <var>Right</var> pans, with the residue remaining on the <var>Table</var>, and three <var>Branches</var>, one of which will be chosen depending on the outcome of the weighing. <pre class="prolog"> step( step(Left,Right,Table,Branches), Left, Right, Table, Branches). </pre> The <var>Branches</var> are three procedures equating to: * > (left pan heavier), * < (right pan heavier) and * <nowiki>= (pans balance).</nowiki> <pre class="prolog"> branch( >, branches(_Equal, GT, _LT), GT ). branch( <, branches(_Equal, _GT, LT), LT ). branch( =, branches(Equal, _GT, _LT), Equal ). </pre> The counterfeit is defined by its number and whether it is heavy or light. <pre class="prolog"> counterfeit( counterfeit(Coin, HeavyOrLight), Coin, HeavyOrLight ). coins( [1,2,3,4,5,6,7,8,9,10,11,12] ). counterfeit_weight( heavy ). counterfeit_weight( light ). </pre> A &lsquo;coin collection&rsquo; comprises four &lsquo;parts&rsquo; (subsets): the <code>known_true</code>, <code>not_heavy</code>, <code>not_light</code> and <code>untested</code> sets of coins. <pre class="prolog"> part( known_true, collection(Coins,_,_,_), Coins ). part( not_heavy, collection(_,Coins,_,_), Coins ). part( not_light, collection(_,_,Coins,_), Coins ). part( untested, collection(_,_,_,Coins), Coins ). </pre> ==Solution== ====solve_coins( +Counterfeit, ?Procedure )==== holds when <var>Procedure</var> can correctly identify the <var>Counterfeit</var> coin. Beginning with a &lsquo;start&rsquo; collection, in which all the coins are untested, the <var>Procedure</var> comprises three &lsquo;steps&rsquo;. For each step, a weighing is made and a &lsquo;branch&rsquo; is made in the <var>Procedure</var>, depending on the result of the weighing. After three steps, the <var>Procedure</var> must have reached the &lsquo;end&rsquo; condition. Finally, an assertion (redundant test) ensures that the <var>Procedure</var> has found the correct end condition. <pre class="prolog"> solve_coins( Counterfeit, Procedure ) :- start( Coins0 ), assay( Counterfeit, Coins0, Procedure, Branch1, Coins1 ), assay( Counterfeit, Coins1, Branch1, Branch2, Coins2 ), assay( Counterfeit, Coins2, Branch2, done(Coin, HeavyOrLight), Coins3 ), end( Coins3, Coin, HeavyOrLight ), counterfeit( Counterfeit, Coin, HeavyOrLight ). start( Coins ) :- coins( Untested ), part( untested, Coins, Untested ), part( not_heavy, Coins, [] ), part( not_light, Coins, [] ), part( known_true, Coins, [] ). end( Coins, Coin, HeavyOrLight ) :- part( untested, Coins, [] ), part( not_heavy, Coins, Light ), part( not_light, Coins, Heavy ), end_result( Heavy, Light, Coin, HeavyOrLight ). end_result( [Coin], [], Coin, heavy ). end_result( [], [Coin], Coin, light ). </pre> === Simulating the weighing process === ====assay( +Counterfeit, +Coins0, ?Step, ?Branch, ?Coins1 )==== holds when the appropriate <var>Branch</var> from <var>Step</var> is chosen by comparing the weights of two coin collections taken from the full set of coins: <var>Coins0</var>. <var>Coins1</var> is the full set of coins updated with the inferences drawn from the weighing, where <var>Counterfeit</var> is used to determine the result of the weighing. This predicate applies the critical insight into the solution of this puzzle: we have 24 (12 &times; 2) possible inputs to the procedure, with only 27 (3 &times; 3 &times; 3) possible outcomes from the weighings. Therefore, it is clear that each weighing must have a very high [[#Information Content|information content]]. Choosing which weighing to make by estimating the available information content makes the problem tractable. <pre class="prolog"> assay( Counterfeit, Coins0, Step, Branch, Coins ) :- WeighingDatum = weighing_data(InfoContent, Left, Right, Table), step( Step, Left, Right, Table, Branches ), findall( WeighingDatum, valid_partition( Coins0, InfoContent, Left, Right, Table ), WeighingData ), sort( WeighingData, OrderedWeighingData ), member( WeighingDatum, OrderedWeighingData ), balance( Left, Right, Counterfeit, Result ), draw_inferences( Result, Left, Right, Table, Coins ), branch( Result, Branches, Branch ). </pre> ====balance( +Left, +Right, +Counterfeit, ?Result )==== holds when <var>Result</var> simulates the outcome of testing the coin collections <var>Left</var> and <var>Right</var> with a balance, where either may contain the <var>Counterfeit</var> coin. <pre class="prolog"> balance( Left, Right, Counterfeit, Result ):- counterfeit( Counterfeit, Coin, Weight ), ( contains_coin( Left, Coin ) -> balance_result( Weight, normal, Result ) ; contains_coin( Right, Coin ) -> balance_result( normal, Weight, Result ) ; otherwise -> Result = '=' ). balance_result( light, normal, < ). balance_result( heavy, normal, > ). balance_result( normal, heavy, < ). balance_result( normal, light, > ). </pre> ===Choosing which coins to weigh=== ====valid_partition( +Coins, ?Content, ?Left, ?Right, ?Table )==== holds when <var>Coins</var> can be partitioned into three collections: <var>Left</var> side, <var>Right</var> side and <var>Table</var>; with the information content of the partition given by <var>Content</var>. The definition of a valid_partition ensures that: * <var>Left</var> and <var>Right</var> must have the same number of coins (at least one); * <var>Left</var> cannot contain any known_true coins, because adding true coins to both sides creates redundant comparisons; * Comparisons between mixtures of coins where only the choice of pans is different are equivalent, so a partial order (&ge;) on mixtures of coins is used to eliminate some redundant comparisons. <pre class="prolog"> valid_partition( Coins, Content, Left, Right, Table ):- part( known_true, Left, [] ), selection( Coins, Left, Coins1, LeftSum, LeftInfo ), selection( Coins1, Right, Table, RightSum, RightInfo ), LeftSum =:= RightSum, LeftSum @>= RightSum, table_information( Table, TableInfo ), sum( [LeftInfo,RightInfo,TableInfo], Content ). </pre> ====selection( +Coins, ?Sample, ?Residue, ?Sum, ?Content )==== holds when <var>Coins</var> is partitioned into two collections: <var>Sample</var> and <var>Residue</var>. <var>Sum</var> is used as both a fingerprint for the mixture of coins in <var>Sample</var> and a representation of the number of coins in <var>Sample</var>. <var>Content</var> estimates the information-content of <var>Sample</var>. <pre class="prolog"> selection( Coins, Sample, Residue, Sum, Content ) :- Sum = Count1+Count2+Count3+Count4, select_coins( not_heavy, Coins, Sample, Residue, Count1 ), select_coins( not_light, Coins, Sample, Residue, Count2 ), select_coins( untested, Coins, Sample, Residue, Count3 ), select_coins( known_true, Coins, Sample, Residue, Count4 ), Sum >= 1, Sum =< 6, information_content( [Count1,Count2,Count3,Count4], Content ). </pre> ====table_information( +Coins, ?Content )==== holds when <var>Coins</var> has 'information content' <var>Content</var>. <pre class="prolog"> table_information( Coins, Content ) :- count_coins( not_heavy, Coins, Count1 ), count_coins( not_light, Coins, Count2 ), count_coins( untested, Coins, Count3 ), count_coins( known_true, Coins, Count4 ), information_content( [Count1,Count2,Count3,Count4], Content ). count_coins( Part, Coins, Count ) :- part( Part, Coins, Selection ), length( Selection, Count ). </pre> === Updating what is known about the coins === ====draw_inferences( +Result, +Left, +Right, +Table, ?Coins )==== holds when <var>Result</var> is one of: * > (imbalance &ndash; left pan heavier), * < (imbalance &ndash; right pan heavier) or * <nowiki>=</nowiki> (pans balanced) from taking a weighing with the coin collections: <var>Left</var>, <var>Right</var> and <var>Table</var>. <var>Coins</var> is derived from this information using the following rules: * If the pans are unbalanced then only the previously untested or not_heavy coins on the lighter side of the balance are now not_heavy. Similarly, only the previously untested or not_light coins on the heavier side of the balance are now not_light. All the coins on the table are now known_true. * If the pans balance then all the coins weighed are known_true, with the coins on the <var>Table</var> left in their prior states. <pre class="prolog"> draw_inferences( <, Left, Right, Table, Coins ) :- imbalance_inferences( Left, Right, Table, Coins ). draw_inferences( >, Left, Right, Table, Coins ) :- imbalance_inferences( Right, Left, Table, Coins ). draw_inferences( =, Left, Right, Table, Coins ) :- becomes( [all(Left),known_true(Table),all(Right)], known_true( Coins ) ), becomes( untested(Table), untested(Coins) ), becomes( not_heavy(Table), not_heavy(Coins) ), becomes( not_light(Table), not_light(Coins) ). </pre> ====imbalance_inferences( +Lighter, +Heavier, +Table, ?Coins )==== holds when: * Only the untested or not_heavy coins in <var>Lighter</var> are not_heavy in <var>Coins</var>; * Only the untested or not_light coins in <var>Heavier</var> are not_light in <var>Coins</var>; * All the other coins in <var>Lighter</var> and <var>Heavier</var> and all the coins in <var>Table</var> are known_true in <var>Coins</var>; There are no untested coins in <var>Coins</var>. <pre class="prolog"> imbalance_inferences( Lighter, Heavier, Table, Coins ) :- becomes( [untested(Lighter),not_heavy(Lighter)], not_heavy(Coins) ), becomes( [untested(Heavier),not_light(Heavier)], not_light(Coins) ), becomes( [ known_true(Lighter), not_light(Lighter), known_true(Heavier), not_heavy(Heavier), all(Table) ], known_true(Coins) ), part( untested, Coins, [] ). </pre> ====becomes( +CollectionA, ?CollectionB )==== <var>CollectionA</var> becomes (part) <var>CollectionB</var> when <var>CollectionB</var> comprises the same coins as <var>CollectionA</var>. <pre class="prolog"> becomes( CollectionA, CollectionB ) :- unfolded( CollectionA, Coins ), unfolded( CollectionB, Coins ). </pre> ====unfolded( +Collection, ?Coins )==== holds when (part) <var>Collection</var> comprises <var>Coins</var>. <pre class="prolog"> unfolded( not_light(Collection), Coins ) :- part( not_light, Collection, Coins ). unfolded( not_heavy(Collection), Coins ) :- part( not_heavy, Collection, Coins ). unfolded( known_true(Collection), Coins ) :- part( known_true, Collection, Coins ). unfolded( untested(Collection), Coins ) :- part( untested, Collection, Coins ). unfolded( all(Collection), Coins ) :- collection_to_set( Collection, Coins ). unfolded( [Item|Items], Coins ) :- unfolded( Item, Value ), unfolded1( Items, Value, Coins ). unfolded1( [], Coins, Coins ). unfolded1( [Item|Items], Value, Coins ) :- unfolded( Item, Value0 ), ord_union( Value0, Value, Value1 ), unfolded1( Items, Value1, Coins ). </pre> ==Definite Clause Grammar== The following DCG represents the method for finding the counterfeit coin as a structured procedure. <pre class="prolog"> general_explanation( Procedure ) --> "Number the coins 1..12", newline, explanation( Procedure, 0 ). explanation( done(Coin, Weight), N ) --> tab( N ), "Conclude that the counterfeit coin is number ", literal( Coin ), ", which is ", literal( Weight ), newline. explanation( Step, N ) --> {step( Step, Left, Right, Table, Branches )}, tab( N ), "BEGIN", newline, tab( N ), "Put ", literal( Left ), " on the left-hand pan", newline, tab( N ), "Put ", literal( Right ), " on the right-hand pan", newline, tab( N ), "Leaving ", literal( Table ), " on the table", newline, branches_explained( Branches, N ), tab( N ), "END", newline. branches_explained( Branches, N ) --> next_step_explained( <, Branches, N ), next_step_explained( >, Branches, N ), next_step_explained( =, Branches, N ). next_step_explained( Result, Branch, N ) --> {branch( Result, Branch, Step )}, ( {var(Step)} -> "" | {nonvar(Step)} -> tab( N ), "If the ", literal( Result ), " then:", newline, explanation( Step, s(N) ) ). literal( 0 ) --> "0". literal( 1 ) --> "1". literal( 2 ) --> "2". literal( 3 ) --> "3". literal( 4 ) --> "4". literal( 5 ) --> "5". literal( 6 ) --> "6". literal( 7 ) --> "7". literal( 8 ) --> "8". literal( 9 ) --> "9". literal( 10 ) --> "10". literal( 11 ) --> "11". literal( 12 ) --> "12". literal( true ) --> "true". literal( heavy ) --> "heavy". literal( light ) --> "light". literal( = ) --> "pans balance". literal( < ) --> "right-hand pan is heavier". literal( > ) --> "left-hand pan is heavier". literal( Collection ) --> {collection_to_set( Collection , [H|T] )}, literal_set( T, H ). literal_set( [], Number ) --> "the coin numbered ", literal( Number ). literal_set( [H|T], Number ) --> "the coins numbered ", literal( Number ), literal_set1( T, H ). literal_set1( [], Number ) --> " and ", literal( Number ). literal_set1( [H|T], Number ) --> ", ", literal( Number ), literal_set1( T, H ). tab( 0 ) --> "". tab( s(N) ) --> " ", tab( N ). newline --> " ". </pre> ===Utility Predicates=== ====contains_coin( ?Collection, ?Coin )==== holds when <var>Coin</var> is a member of <var>Collection</var>. <pre class="prolog"> contains_coin( Collection, Coin ) :- part( _Part, Collection, Coins ), member( Coin, Coins ). </pre> ====collection_to_set( +Collection, ?Set )==== holds when <var>Set</var> is the distributed union of the <code>known_true</code>, <code>not_heavy</code>, <code>not_light</code> and <code>untested</code> ordsets comprising <var>Collection</var>. <pre class="prolog"> collection_to_set( Collection, Set ) :- part( known_true, Collection, KnownTrue ), part( not_heavy, Collection, NotHeavy ), part( not_light, Collection, NotLight ), part( untested, Collection, Untested ), ord_union( [KnownTrue,NotHeavy,NotLight,Untested], Set ). </pre> ===Information Content=== ==== information_content( +Counts, ?Content ) ==== holds when <var>Content</var> is the cumulative negative entropy of <var>Counts</var>. A reduction in entropy equates to a gain in information. <pre class="prolog"> information_content( Counts, Content ) :- information_content1( Counts, 0, Content ). information_content1( [], Content, Content ). information_content1( [Count|Counts], Content0, Content ):- coins_entropy( Count, Entropy ), Content1 is Content0-Entropy, information_content1( Counts, Content1, Content ). </pre> ==== coins_entropy( ?N, ?Entropy ) ==== holds when <var>Entropy</var> estimates the entropy of a sample of <var>N</var> coins. <var>Entropy</var> = P log₂(¹&frasl;_P), where P = <var>N</var>&divide;12. <pre class="prolog"> coins_entropy( 0, 0.0 ). coins_entropy( 1, 0.2987 ). coins_entropy( 2, 0.4308 ). coins_entropy( 3, 0.5 ). coins_entropy( 4, 0.5283 ). coins_entropy( 5, 0.5263 ). coins_entropy( 6, 0.5 ). coins_entropy( 7, 0.4536 ). coins_entropy( 8, 0.39 ). coins_entropy( 9, 0.3113 ). coins_entropy( 10, 0.2192 ). coins_entropy( 11, 0.1151 ). coins_entropy( 12, 0.0 ). </pre> ====select_coins( +Part, +Coins, ?Sample, ?Residue, ?N )==== holds when <var>N</var> coins from <var>Part</var> of <var>Coins</var> form <var>Part</var> of <var>Sample</var>, with the remainder forming <var>Part</var> of <var>Residue</var>. <pre class="prolog"> select_coins( Part, Coins, Sample, Residue, Count ) :- part( Part, Coins, Input ), part( Part, Sample, Selection ), part( Part, Residue, Remainder ), select_n( Count, Input, Selection, Remainder ). select_n( 0, In, [], In ). select_n( 1, [A|Suffix], [A], Suffix ). select_n( 2, [A,B|Suffix], [A,B], Suffix ). select_n( 3, [A,B,C|Suffix], [A,B,C], Suffix ). select_n( 4, [A,B,C,D|Suffix], [A,B,C,D], Suffix ). select_n( 5, [A,B,C,D,E|Suffix], [A,B,C,D,E], Suffix ). select_n( 6, [A,B,C,D,E,F|Suffix], [A,B,C,D,E,F], Suffix ). </pre> Load a small library of [[Puzzle Utilities]]. <pre class="prolog"> :- ensure_loaded( misc ). </pre> Use the ordsets library. <pre class="prolog"> :- use_module( library(ordsets), [ord_union/2,ord_union/3] ). </pre> The code is available as plain text [https://binding-time.co.uk/download/counterfeit.txt here]. ==Output== <div class="result"> Number the coins 1..12 BEGIN Put the coins numbered 1, 2, 3 and 4 on the left-hand pan Put the coins numbered 5, 6, 7 and 8 on the right-hand pan Leaving the coins numbered 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 1, 2, 5 and 6 on the left-hand pan Put the coins numbered 3, 7, 9 and 10 on the right-hand pan Leaving the coins numbered 4, 8, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 1 and 7 on the left-hand pan Put the coins numbered 3 and 4 on the right-hand pan Leaving the coins numbered 2, 5, 6, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 1, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 7, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 2, which is light END If the left-hand pan is heavier then: BEGIN Put the coins numbered 3 and 5 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 4, 6, 7, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 3, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 5, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 6, which is heavy END If the pans balance then: BEGIN Put the coins numbered 4 and 8 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 3, 5, 6, 7, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 4, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 8, which is heavy END END If the left-hand pan is heavier then: BEGIN Put the coins numbered 1, 2, 5 and 6 on the left-hand pan Put the coins numbered 3, 7, 9 and 10 on the right-hand pan Leaving the coins numbered 4, 8, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 3 and 5 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 4, 6, 7, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 5, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 3, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 6, which is light END If the left-hand pan is heavier then: BEGIN Put the coins numbered 1 and 7 on the left-hand pan Put the coins numbered 3 and 4 on the right-hand pan Leaving the coins numbered 2, 5, 6, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 7, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 1, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 2, which is heavy END If the pans balance then: BEGIN Put the coins numbered 4 and 8 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 3, 5, 6, 7, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 8, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 4, which is heavy END END If the pans balance then: BEGIN Put the coins numbered 9, 10 and 11 on the left-hand pan Put the coins numbered 1, 2 and 3 on the right-hand pan Leaving the coins numbered 4, 5, 6, 7, 8 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coin numbered 9 on the left-hand pan Put the coin numbered 10 on the right-hand pan Leaving the coins numbered 1, 2, 3, 4, 5, 6, 7, 8, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 9, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 10, which is light If the pans balance then: Conclude that the counterfeit coin is number 11, which is light END If the left-hand pan is heavier then: BEGIN Put the coin numbered 9 on the left-hand pan Put the coin numbered 10 on the right-hand pan Leaving the coins numbered 1, 2, 3, 4, 5, 6, 7, 8, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 10, which is heavy If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 9, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 11, which is heavy END If the pans balance then: BEGIN Put the coin numbered 12 on the left-hand pan Put the coin numbered 1 on the right-hand pan Leaving the coins numbered 2, 3, 4, 5, 6, 7, 8, 9, 10 and 11 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 12, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 12, which is heavy END END END </div> ---- 675466919bd682adc3ed91a05631b6a7b1101a32 188 183 2017-02-20T14:03:54Z John 2 /* coins_puzzle( ?Procedure ) */ wikitext text/x-wiki __NOTOC__ ==Problem Definition== We are given 12 apparently identical coins - one of which is counterfeit. We know that the counterfeit has a different weight from the others, but we don't know if it's heavier or lighter. ===Task:=== Devise a procedure to identify any counterfeit coin using a balance to take up to three comparative weighings. ==Strategy== The information from three suitable weighings will make all but one of the coins, which are untested initially, known_true. There are three alternative deductions that make a coin known_true: * if it is not_heavy and not_light &ndash; having been on both the comparatively lighter and heavier sides of imbalances; * if it was excluded from an imbalance; * if it was included in a balanced weighing. After three weighings there must be exactly one coin, the counterfeit, which is not known_true. If the counterfeit is not known_true and not_heavy we deduce that it must be light. If it is not known_true and not_light, it must be heavy. We use a generate-and-test method as follows: * Create the set of all possible counterfeits: 12 coins &times; 2 weights ; * Devise a procedure that can identify the first counterfeit coin; * Show that the same procedure works for every other counterfeit coin. ==Entry Point== ====go==== is the entry point. It solves the puzzle, then uses a DCG to pretty-print the resulting procedure. <pre class="prolog"> go :- coins_puzzle( Procedure ), phrase( general_explanation( Procedure ), Chars ), put_chars( Chars ). </pre> ====coins_puzzle( ?Procedure )==== generates the set of all possible counterfeit coins and finds, or proves, that <var>Procedure</var> can identify them all. <pre class="prolog"> coins_puzzle( Procedure ) :- coins( Coins ), counterfeit( Counterfeit, Coin, Weight ), findall( Counterfeit, (member(Coin,Coins), counterfeit_weight(Weight)), Counterfeits ), coins_puzzle_solution( Counterfeits, Procedure ). coins_puzzle_solution( [], _Procedure ). coins_puzzle_solution( [Counterfeit|Counterfeits], Procedure ) :- solve_coins( Counterfeit, Procedure ), coins_puzzle_solution( Counterfeits, Procedure ). </pre> A procedure is either ''done'', identifying a particular coin and whether it is heavy or light, or it is a ''step''. A ''step'' defines the coins to be placed on the <var>Left</var> and <var>Right</var> pans, with the residue remaining on the <var>Table</var>, and three <var>Branches</var>, one of which will be chosen depending on the outcome of the weighing. <pre class="prolog"> step( step(Left,Right,Table,Branches), Left, Right, Table, Branches). </pre> The <var>Branches</var> are three procedures equating to: * > (left pan heavier), * < (right pan heavier) and * <nowiki>= (pans balance).</nowiki> <pre class="prolog"> branch( >, branches(_Equal, GT, _LT), GT ). branch( <, branches(_Equal, _GT, LT), LT ). branch( =, branches(Equal, _GT, _LT), Equal ). </pre> The counterfeit is defined by its number and whether it is heavy or light. <pre class="prolog"> counterfeit( counterfeit(Coin, HeavyOrLight), Coin, HeavyOrLight ). coins( [1,2,3,4,5,6,7,8,9,10,11,12] ). counterfeit_weight( heavy ). counterfeit_weight( light ). </pre> A ''coin collection'' comprises four <code>part</code>s (subsets): the <code>known_true</code>, <code>not_heavy</code>, <code>not_light</code> and <code>untested</code> sets of coins. <pre class="prolog"> part( known_true, collection(Coins,_,_,_), Coins ). part( not_heavy, collection(_,Coins,_,_), Coins ). part( not_light, collection(_,_,Coins,_), Coins ). part( untested, collection(_,_,_,Coins), Coins ). </pre> ==Solution== ====solve_coins( +Counterfeit, ?Procedure )==== holds when <var>Procedure</var> can correctly identify the <var>Counterfeit</var> coin. Beginning with a &lsquo;start&rsquo; collection, in which all the coins are untested, the <var>Procedure</var> comprises three &lsquo;steps&rsquo;. For each step, a weighing is made and a &lsquo;branch&rsquo; is made in the <var>Procedure</var>, depending on the result of the weighing. After three steps, the <var>Procedure</var> must have reached the &lsquo;end&rsquo; condition. Finally, an assertion (redundant test) ensures that the <var>Procedure</var> has found the correct end condition. <pre class="prolog"> solve_coins( Counterfeit, Procedure ) :- start( Coins0 ), assay( Counterfeit, Coins0, Procedure, Branch1, Coins1 ), assay( Counterfeit, Coins1, Branch1, Branch2, Coins2 ), assay( Counterfeit, Coins2, Branch2, done(Coin, HeavyOrLight), Coins3 ), end( Coins3, Coin, HeavyOrLight ), counterfeit( Counterfeit, Coin, HeavyOrLight ). start( Coins ) :- coins( Untested ), part( untested, Coins, Untested ), part( not_heavy, Coins, [] ), part( not_light, Coins, [] ), part( known_true, Coins, [] ). end( Coins, Coin, HeavyOrLight ) :- part( untested, Coins, [] ), part( not_heavy, Coins, Light ), part( not_light, Coins, Heavy ), end_result( Heavy, Light, Coin, HeavyOrLight ). end_result( [Coin], [], Coin, heavy ). end_result( [], [Coin], Coin, light ). </pre> === Simulating the weighing process === ====assay( +Counterfeit, +Coins0, ?Step, ?Branch, ?Coins1 )==== holds when the appropriate <var>Branch</var> from <var>Step</var> is chosen by comparing the weights of two coin collections taken from the full set of coins: <var>Coins0</var>. <var>Coins1</var> is the full set of coins updated with the inferences drawn from the weighing, where <var>Counterfeit</var> is used to determine the result of the weighing. This predicate applies the critical insight into the solution of this puzzle: we have 24 (12 &times; 2) possible inputs to the procedure, with only 27 (3 &times; 3 &times; 3) possible outcomes from the weighings. Therefore, it is clear that each weighing must have a very high [[#Information Content|information content]]. Choosing which weighing to make by estimating the available information content makes the problem tractable. <pre class="prolog"> assay( Counterfeit, Coins0, Step, Branch, Coins ) :- WeighingDatum = weighing_data(InfoContent, Left, Right, Table), step( Step, Left, Right, Table, Branches ), findall( WeighingDatum, valid_partition( Coins0, InfoContent, Left, Right, Table ), WeighingData ), sort( WeighingData, OrderedWeighingData ), member( WeighingDatum, OrderedWeighingData ), balance( Left, Right, Counterfeit, Result ), draw_inferences( Result, Left, Right, Table, Coins ), branch( Result, Branches, Branch ). </pre> ====balance( +Left, +Right, +Counterfeit, ?Result )==== holds when <var>Result</var> simulates the outcome of testing the coin collections <var>Left</var> and <var>Right</var> with a balance, where either may contain the <var>Counterfeit</var> coin. <pre class="prolog"> balance( Left, Right, Counterfeit, Result ):- counterfeit( Counterfeit, Coin, Weight ), ( contains_coin( Left, Coin ) -> balance_result( Weight, normal, Result ) ; contains_coin( Right, Coin ) -> balance_result( normal, Weight, Result ) ; otherwise -> Result = '=' ). balance_result( light, normal, < ). balance_result( heavy, normal, > ). balance_result( normal, heavy, < ). balance_result( normal, light, > ). </pre> ===Choosing which coins to weigh=== ====valid_partition( +Coins, ?Content, ?Left, ?Right, ?Table )==== holds when <var>Coins</var> can be partitioned into three collections: <var>Left</var> side, <var>Right</var> side and <var>Table</var>; with the information content of the partition given by <var>Content</var>. The definition of a valid_partition ensures that: * <var>Left</var> and <var>Right</var> must have the same number of coins (at least one); * <var>Left</var> cannot contain any known_true coins, because adding true coins to both sides creates redundant comparisons; * Comparisons between mixtures of coins where only the choice of pans is different are equivalent, so a partial order (&ge;) on mixtures of coins is used to eliminate some redundant comparisons. <pre class="prolog"> valid_partition( Coins, Content, Left, Right, Table ):- part( known_true, Left, [] ), selection( Coins, Left, Coins1, LeftSum, LeftInfo ), selection( Coins1, Right, Table, RightSum, RightInfo ), LeftSum =:= RightSum, LeftSum @>= RightSum, table_information( Table, TableInfo ), sum( [LeftInfo,RightInfo,TableInfo], Content ). </pre> ====selection( +Coins, ?Sample, ?Residue, ?Sum, ?Content )==== holds when <var>Coins</var> is partitioned into two collections: <var>Sample</var> and <var>Residue</var>. <var>Sum</var> is used as both a fingerprint for the mixture of coins in <var>Sample</var> and a representation of the number of coins in <var>Sample</var>. <var>Content</var> estimates the information-content of <var>Sample</var>. <pre class="prolog"> selection( Coins, Sample, Residue, Sum, Content ) :- Sum = Count1+Count2+Count3+Count4, select_coins( not_heavy, Coins, Sample, Residue, Count1 ), select_coins( not_light, Coins, Sample, Residue, Count2 ), select_coins( untested, Coins, Sample, Residue, Count3 ), select_coins( known_true, Coins, Sample, Residue, Count4 ), Sum >= 1, Sum =< 6, information_content( [Count1,Count2,Count3,Count4], Content ). </pre> ====table_information( +Coins, ?Content )==== holds when <var>Coins</var> has 'information content' <var>Content</var>. <pre class="prolog"> table_information( Coins, Content ) :- count_coins( not_heavy, Coins, Count1 ), count_coins( not_light, Coins, Count2 ), count_coins( untested, Coins, Count3 ), count_coins( known_true, Coins, Count4 ), information_content( [Count1,Count2,Count3,Count4], Content ). count_coins( Part, Coins, Count ) :- part( Part, Coins, Selection ), length( Selection, Count ). </pre> === Updating what is known about the coins === ====draw_inferences( +Result, +Left, +Right, +Table, ?Coins )==== holds when <var>Result</var> is one of: * > (imbalance &ndash; left pan heavier), * < (imbalance &ndash; right pan heavier) or * <nowiki>=</nowiki> (pans balanced) from taking a weighing with the coin collections: <var>Left</var>, <var>Right</var> and <var>Table</var>. <var>Coins</var> is derived from this information using the following rules: * If the pans are unbalanced then only the previously untested or not_heavy coins on the lighter side of the balance are now not_heavy. Similarly, only the previously untested or not_light coins on the heavier side of the balance are now not_light. All the coins on the table are now known_true. * If the pans balance then all the coins weighed are known_true, with the coins on the <var>Table</var> left in their prior states. <pre class="prolog"> draw_inferences( <, Left, Right, Table, Coins ) :- imbalance_inferences( Left, Right, Table, Coins ). draw_inferences( >, Left, Right, Table, Coins ) :- imbalance_inferences( Right, Left, Table, Coins ). draw_inferences( =, Left, Right, Table, Coins ) :- becomes( [all(Left),known_true(Table),all(Right)], known_true( Coins ) ), becomes( untested(Table), untested(Coins) ), becomes( not_heavy(Table), not_heavy(Coins) ), becomes( not_light(Table), not_light(Coins) ). </pre> ====imbalance_inferences( +Lighter, +Heavier, +Table, ?Coins )==== holds when: * Only the untested or not_heavy coins in <var>Lighter</var> are not_heavy in <var>Coins</var>; * Only the untested or not_light coins in <var>Heavier</var> are not_light in <var>Coins</var>; * All the other coins in <var>Lighter</var> and <var>Heavier</var> and all the coins in <var>Table</var> are known_true in <var>Coins</var>; There are no untested coins in <var>Coins</var>. <pre class="prolog"> imbalance_inferences( Lighter, Heavier, Table, Coins ) :- becomes( [untested(Lighter),not_heavy(Lighter)], not_heavy(Coins) ), becomes( [untested(Heavier),not_light(Heavier)], not_light(Coins) ), becomes( [ known_true(Lighter), not_light(Lighter), known_true(Heavier), not_heavy(Heavier), all(Table) ], known_true(Coins) ), part( untested, Coins, [] ). </pre> ====becomes( +CollectionA, ?CollectionB )==== <var>CollectionA</var> becomes (part) <var>CollectionB</var> when <var>CollectionB</var> comprises the same coins as <var>CollectionA</var>. <pre class="prolog"> becomes( CollectionA, CollectionB ) :- unfolded( CollectionA, Coins ), unfolded( CollectionB, Coins ). </pre> ====unfolded( +Collection, ?Coins )==== holds when (part) <var>Collection</var> comprises <var>Coins</var>. <pre class="prolog"> unfolded( not_light(Collection), Coins ) :- part( not_light, Collection, Coins ). unfolded( not_heavy(Collection), Coins ) :- part( not_heavy, Collection, Coins ). unfolded( known_true(Collection), Coins ) :- part( known_true, Collection, Coins ). unfolded( untested(Collection), Coins ) :- part( untested, Collection, Coins ). unfolded( all(Collection), Coins ) :- collection_to_set( Collection, Coins ). unfolded( [Item|Items], Coins ) :- unfolded( Item, Value ), unfolded1( Items, Value, Coins ). unfolded1( [], Coins, Coins ). unfolded1( [Item|Items], Value, Coins ) :- unfolded( Item, Value0 ), ord_union( Value0, Value, Value1 ), unfolded1( Items, Value1, Coins ). </pre> ==Definite Clause Grammar== The following DCG represents the method for finding the counterfeit coin as a structured procedure. <pre class="prolog"> general_explanation( Procedure ) --> "Number the coins 1..12", newline, explanation( Procedure, 0 ). explanation( done(Coin, Weight), N ) --> tab( N ), "Conclude that the counterfeit coin is number ", literal( Coin ), ", which is ", literal( Weight ), newline. explanation( Step, N ) --> {step( Step, Left, Right, Table, Branches )}, tab( N ), "BEGIN", newline, tab( N ), "Put ", literal( Left ), " on the left-hand pan", newline, tab( N ), "Put ", literal( Right ), " on the right-hand pan", newline, tab( N ), "Leaving ", literal( Table ), " on the table", newline, branches_explained( Branches, N ), tab( N ), "END", newline. branches_explained( Branches, N ) --> next_step_explained( <, Branches, N ), next_step_explained( >, Branches, N ), next_step_explained( =, Branches, N ). next_step_explained( Result, Branch, N ) --> {branch( Result, Branch, Step )}, ( {var(Step)} -> "" | {nonvar(Step)} -> tab( N ), "If the ", literal( Result ), " then:", newline, explanation( Step, s(N) ) ). literal( 0 ) --> "0". literal( 1 ) --> "1". literal( 2 ) --> "2". literal( 3 ) --> "3". literal( 4 ) --> "4". literal( 5 ) --> "5". literal( 6 ) --> "6". literal( 7 ) --> "7". literal( 8 ) --> "8". literal( 9 ) --> "9". literal( 10 ) --> "10". literal( 11 ) --> "11". literal( 12 ) --> "12". literal( true ) --> "true". literal( heavy ) --> "heavy". literal( light ) --> "light". literal( = ) --> "pans balance". literal( < ) --> "right-hand pan is heavier". literal( > ) --> "left-hand pan is heavier". literal( Collection ) --> {collection_to_set( Collection , [H|T] )}, literal_set( T, H ). literal_set( [], Number ) --> "the coin numbered ", literal( Number ). literal_set( [H|T], Number ) --> "the coins numbered ", literal( Number ), literal_set1( T, H ). literal_set1( [], Number ) --> " and ", literal( Number ). literal_set1( [H|T], Number ) --> ", ", literal( Number ), literal_set1( T, H ). tab( 0 ) --> "". tab( s(N) ) --> " ", tab( N ). newline --> " ". </pre> ===Utility Predicates=== ====contains_coin( ?Collection, ?Coin )==== holds when <var>Coin</var> is a member of <var>Collection</var>. <pre class="prolog"> contains_coin( Collection, Coin ) :- part( _Part, Collection, Coins ), member( Coin, Coins ). </pre> ====collection_to_set( +Collection, ?Set )==== holds when <var>Set</var> is the distributed union of the <code>known_true</code>, <code>not_heavy</code>, <code>not_light</code> and <code>untested</code> ordsets comprising <var>Collection</var>. <pre class="prolog"> collection_to_set( Collection, Set ) :- part( known_true, Collection, KnownTrue ), part( not_heavy, Collection, NotHeavy ), part( not_light, Collection, NotLight ), part( untested, Collection, Untested ), ord_union( [KnownTrue,NotHeavy,NotLight,Untested], Set ). </pre> ===Information Content=== ==== information_content( +Counts, ?Content ) ==== holds when <var>Content</var> is the cumulative negative entropy of <var>Counts</var>. A reduction in entropy equates to a gain in information. <pre class="prolog"> information_content( Counts, Content ) :- information_content1( Counts, 0, Content ). information_content1( [], Content, Content ). information_content1( [Count|Counts], Content0, Content ):- coins_entropy( Count, Entropy ), Content1 is Content0-Entropy, information_content1( Counts, Content1, Content ). </pre> ==== coins_entropy( ?N, ?Entropy ) ==== holds when <var>Entropy</var> estimates the entropy of a sample of <var>N</var> coins. <var>Entropy</var> = P log₂(¹&frasl;_P), where P = <var>N</var>&divide;12. <pre class="prolog"> coins_entropy( 0, 0.0 ). coins_entropy( 1, 0.2987 ). coins_entropy( 2, 0.4308 ). coins_entropy( 3, 0.5 ). coins_entropy( 4, 0.5283 ). coins_entropy( 5, 0.5263 ). coins_entropy( 6, 0.5 ). coins_entropy( 7, 0.4536 ). coins_entropy( 8, 0.39 ). coins_entropy( 9, 0.3113 ). coins_entropy( 10, 0.2192 ). coins_entropy( 11, 0.1151 ). coins_entropy( 12, 0.0 ). </pre> ====select_coins( +Part, +Coins, ?Sample, ?Residue, ?N )==== holds when <var>N</var> coins from <var>Part</var> of <var>Coins</var> form <var>Part</var> of <var>Sample</var>, with the remainder forming <var>Part</var> of <var>Residue</var>. <pre class="prolog"> select_coins( Part, Coins, Sample, Residue, Count ) :- part( Part, Coins, Input ), part( Part, Sample, Selection ), part( Part, Residue, Remainder ), select_n( Count, Input, Selection, Remainder ). select_n( 0, In, [], In ). select_n( 1, [A|Suffix], [A], Suffix ). select_n( 2, [A,B|Suffix], [A,B], Suffix ). select_n( 3, [A,B,C|Suffix], [A,B,C], Suffix ). select_n( 4, [A,B,C,D|Suffix], [A,B,C,D], Suffix ). select_n( 5, [A,B,C,D,E|Suffix], [A,B,C,D,E], Suffix ). select_n( 6, [A,B,C,D,E,F|Suffix], [A,B,C,D,E,F], Suffix ). </pre> Load a small library of [[Puzzle Utilities]]. <pre class="prolog"> :- ensure_loaded( misc ). </pre> Use the ordsets library. <pre class="prolog"> :- use_module( library(ordsets), [ord_union/2,ord_union/3] ). </pre> The code is available as plain text [https://binding-time.co.uk/download/counterfeit.txt here]. ==Output== <div class="result"> Number the coins 1..12 BEGIN Put the coins numbered 1, 2, 3 and 4 on the left-hand pan Put the coins numbered 5, 6, 7 and 8 on the right-hand pan Leaving the coins numbered 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 1, 2, 5 and 6 on the left-hand pan Put the coins numbered 3, 7, 9 and 10 on the right-hand pan Leaving the coins numbered 4, 8, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 1 and 7 on the left-hand pan Put the coins numbered 3 and 4 on the right-hand pan Leaving the coins numbered 2, 5, 6, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 1, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 7, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 2, which is light END If the left-hand pan is heavier then: BEGIN Put the coins numbered 3 and 5 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 4, 6, 7, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 3, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 5, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 6, which is heavy END If the pans balance then: BEGIN Put the coins numbered 4 and 8 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 3, 5, 6, 7, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 4, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 8, which is heavy END END If the left-hand pan is heavier then: BEGIN Put the coins numbered 1, 2, 5 and 6 on the left-hand pan Put the coins numbered 3, 7, 9 and 10 on the right-hand pan Leaving the coins numbered 4, 8, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 3 and 5 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 4, 6, 7, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 5, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 3, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 6, which is light END If the left-hand pan is heavier then: BEGIN Put the coins numbered 1 and 7 on the left-hand pan Put the coins numbered 3 and 4 on the right-hand pan Leaving the coins numbered 2, 5, 6, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 7, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 1, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 2, which is heavy END If the pans balance then: BEGIN Put the coins numbered 4 and 8 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 3, 5, 6, 7, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 8, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 4, which is heavy END END If the pans balance then: BEGIN Put the coins numbered 9, 10 and 11 on the left-hand pan Put the coins numbered 1, 2 and 3 on the right-hand pan Leaving the coins numbered 4, 5, 6, 7, 8 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coin numbered 9 on the left-hand pan Put the coin numbered 10 on the right-hand pan Leaving the coins numbered 1, 2, 3, 4, 5, 6, 7, 8, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 9, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 10, which is light If the pans balance then: Conclude that the counterfeit coin is number 11, which is light END If the left-hand pan is heavier then: BEGIN Put the coin numbered 9 on the left-hand pan Put the coin numbered 10 on the right-hand pan Leaving the coins numbered 1, 2, 3, 4, 5, 6, 7, 8, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 10, which is heavy If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 9, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 11, which is heavy END If the pans balance then: BEGIN Put the coin numbered 12 on the left-hand pan Put the coin numbered 1 on the right-hand pan Leaving the coins numbered 2, 3, 4, 5, 6, 7, 8, 9, 10 and 11 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 12, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 12, which is heavy END END END </div> ---- ed62538c8ee6463104eb8c9ed9c3306096a31ce7 190 188 2017-02-21T14:56:50Z John 2 /* solve_coins( +Counterfeit, ?Procedure ) */ wikitext text/x-wiki __NOTOC__ ==Problem Definition== We are given 12 apparently identical coins - one of which is counterfeit. We know that the counterfeit has a different weight from the others, but we don't know if it's heavier or lighter. ===Task:=== Devise a procedure to identify any counterfeit coin using a balance to take up to three comparative weighings. ==Strategy== The information from three suitable weighings will make all but one of the coins, which are untested initially, known_true. There are three alternative deductions that make a coin known_true: * if it is not_heavy and not_light &ndash; having been on both the comparatively lighter and heavier sides of imbalances; * if it was excluded from an imbalance; * if it was included in a balanced weighing. After three weighings there must be exactly one coin, the counterfeit, which is not known_true. If the counterfeit is not known_true and not_heavy we deduce that it must be light. If it is not known_true and not_light, it must be heavy. We use a generate-and-test method as follows: * Create the set of all possible counterfeits: 12 coins &times; 2 weights ; * Devise a procedure that can identify the first counterfeit coin; * Show that the same procedure works for every other counterfeit coin. ==Entry Point== ====go==== is the entry point. It solves the puzzle, then uses a DCG to pretty-print the resulting procedure. <pre class="prolog"> go :- coins_puzzle( Procedure ), phrase( general_explanation( Procedure ), Chars ), put_chars( Chars ). </pre> ====coins_puzzle( ?Procedure )==== generates the set of all possible counterfeit coins and finds, or proves, that <var>Procedure</var> can identify them all. <pre class="prolog"> coins_puzzle( Procedure ) :- coins( Coins ), counterfeit( Counterfeit, Coin, Weight ), findall( Counterfeit, (member(Coin,Coins), counterfeit_weight(Weight)), Counterfeits ), coins_puzzle_solution( Counterfeits, Procedure ). coins_puzzle_solution( [], _Procedure ). coins_puzzle_solution( [Counterfeit|Counterfeits], Procedure ) :- solve_coins( Counterfeit, Procedure ), coins_puzzle_solution( Counterfeits, Procedure ). </pre> A procedure is either ''done'', identifying a particular coin and whether it is heavy or light, or it is a ''step''. A ''step'' defines the coins to be placed on the <var>Left</var> and <var>Right</var> pans, with the residue remaining on the <var>Table</var>, and three <var>Branches</var>, one of which will be chosen depending on the outcome of the weighing. <pre class="prolog"> step( step(Left,Right,Table,Branches), Left, Right, Table, Branches). </pre> The <var>Branches</var> are three procedures equating to: * > (left pan heavier), * < (right pan heavier) and * <nowiki>= (pans balance).</nowiki> <pre class="prolog"> branch( >, branches(_Equal, GT, _LT), GT ). branch( <, branches(_Equal, _GT, LT), LT ). branch( =, branches(Equal, _GT, _LT), Equal ). </pre> The counterfeit is defined by its number and whether it is heavy or light. <pre class="prolog"> counterfeit( counterfeit(Coin, HeavyOrLight), Coin, HeavyOrLight ). coins( [1,2,3,4,5,6,7,8,9,10,11,12] ). counterfeit_weight( heavy ). counterfeit_weight( light ). </pre> A ''coin collection'' comprises four <code>part</code>s (subsets): the <code>known_true</code>, <code>not_heavy</code>, <code>not_light</code> and <code>untested</code> sets of coins. <pre class="prolog"> part( known_true, collection(Coins,_,_,_), Coins ). part( not_heavy, collection(_,Coins,_,_), Coins ). part( not_light, collection(_,_,Coins,_), Coins ). part( untested, collection(_,_,_,Coins), Coins ). </pre> ==Solution== ====solve_coins( +Counterfeit, ?Procedure )==== holds when <var>Procedure</var> can correctly identify the <var>Counterfeit</var> coin. Beginning with a ''start'' collection, in which all the coins are untested, the <var>Procedure</var> comprises three steps. For each step, a weighing is made and a ''branch'' is made in the <var>Procedure</var>, depending on the result of the weighing. After three steps, the <var>Procedure</var> must have reached the ''end'' condition. Finally, an assertion (redundant test) ensures that the <var>Procedure</var> has found the correct ''end'' condition. <pre class="prolog"> solve_coins( Counterfeit, Procedure ) :- start( Coins0 ), assay( Counterfeit, Coins0, Procedure, Branch1, Coins1 ), assay( Counterfeit, Coins1, Branch1, Branch2, Coins2 ), assay( Counterfeit, Coins2, Branch2, done(Coin, HeavyOrLight), Coins3 ), end( Coins3, Coin, HeavyOrLight ), counterfeit( Counterfeit, Coin, HeavyOrLight ). start( Coins ) :- coins( Untested ), part( untested, Coins, Untested ), part( not_heavy, Coins, [] ), part( not_light, Coins, [] ), part( known_true, Coins, [] ). end( Coins, Coin, HeavyOrLight ) :- part( untested, Coins, [] ), part( not_heavy, Coins, Light ), part( not_light, Coins, Heavy ), end_result( Heavy, Light, Coin, HeavyOrLight ). end_result( [Coin], [], Coin, heavy ). end_result( [], [Coin], Coin, light ). </pre> === Simulating the weighing process === ====assay( +Counterfeit, +Coins0, ?Step, ?Branch, ?Coins1 )==== holds when the appropriate <var>Branch</var> from <var>Step</var> is chosen by comparing the weights of two coin collections taken from the full set of coins: <var>Coins0</var>. <var>Coins1</var> is the full set of coins updated with the inferences drawn from the weighing, where <var>Counterfeit</var> is used to determine the result of the weighing. This predicate applies the critical insight into the solution of this puzzle: we have 24 (12 &times; 2) possible inputs to the procedure, with only 27 (3 &times; 3 &times; 3) possible outcomes from the weighings. Therefore, it is clear that each weighing must have a very high [[#Information Content|information content]]. Choosing which weighing to make by estimating the available information content makes the problem tractable. <pre class="prolog"> assay( Counterfeit, Coins0, Step, Branch, Coins ) :- WeighingDatum = weighing_data(InfoContent, Left, Right, Table), step( Step, Left, Right, Table, Branches ), findall( WeighingDatum, valid_partition( Coins0, InfoContent, Left, Right, Table ), WeighingData ), sort( WeighingData, OrderedWeighingData ), member( WeighingDatum, OrderedWeighingData ), balance( Left, Right, Counterfeit, Result ), draw_inferences( Result, Left, Right, Table, Coins ), branch( Result, Branches, Branch ). </pre> ====balance( +Left, +Right, +Counterfeit, ?Result )==== holds when <var>Result</var> simulates the outcome of testing the coin collections <var>Left</var> and <var>Right</var> with a balance, where either may contain the <var>Counterfeit</var> coin. <pre class="prolog"> balance( Left, Right, Counterfeit, Result ):- counterfeit( Counterfeit, Coin, Weight ), ( contains_coin( Left, Coin ) -> balance_result( Weight, normal, Result ) ; contains_coin( Right, Coin ) -> balance_result( normal, Weight, Result ) ; otherwise -> Result = '=' ). balance_result( light, normal, < ). balance_result( heavy, normal, > ). balance_result( normal, heavy, < ). balance_result( normal, light, > ). </pre> ===Choosing which coins to weigh=== ====valid_partition( +Coins, ?Content, ?Left, ?Right, ?Table )==== holds when <var>Coins</var> can be partitioned into three collections: <var>Left</var> side, <var>Right</var> side and <var>Table</var>; with the information content of the partition given by <var>Content</var>. The definition of a valid_partition ensures that: * <var>Left</var> and <var>Right</var> must have the same number of coins (at least one); * <var>Left</var> cannot contain any known_true coins, because adding true coins to both sides creates redundant comparisons; * Comparisons between mixtures of coins where only the choice of pans is different are equivalent, so a partial order (&ge;) on mixtures of coins is used to eliminate some redundant comparisons. <pre class="prolog"> valid_partition( Coins, Content, Left, Right, Table ):- part( known_true, Left, [] ), selection( Coins, Left, Coins1, LeftSum, LeftInfo ), selection( Coins1, Right, Table, RightSum, RightInfo ), LeftSum =:= RightSum, LeftSum @>= RightSum, table_information( Table, TableInfo ), sum( [LeftInfo,RightInfo,TableInfo], Content ). </pre> ====selection( +Coins, ?Sample, ?Residue, ?Sum, ?Content )==== holds when <var>Coins</var> is partitioned into two collections: <var>Sample</var> and <var>Residue</var>. <var>Sum</var> is used as both a fingerprint for the mixture of coins in <var>Sample</var> and a representation of the number of coins in <var>Sample</var>. <var>Content</var> estimates the information-content of <var>Sample</var>. <pre class="prolog"> selection( Coins, Sample, Residue, Sum, Content ) :- Sum = Count1+Count2+Count3+Count4, select_coins( not_heavy, Coins, Sample, Residue, Count1 ), select_coins( not_light, Coins, Sample, Residue, Count2 ), select_coins( untested, Coins, Sample, Residue, Count3 ), select_coins( known_true, Coins, Sample, Residue, Count4 ), Sum >= 1, Sum =< 6, information_content( [Count1,Count2,Count3,Count4], Content ). </pre> ====table_information( +Coins, ?Content )==== holds when <var>Coins</var> has 'information content' <var>Content</var>. <pre class="prolog"> table_information( Coins, Content ) :- count_coins( not_heavy, Coins, Count1 ), count_coins( not_light, Coins, Count2 ), count_coins( untested, Coins, Count3 ), count_coins( known_true, Coins, Count4 ), information_content( [Count1,Count2,Count3,Count4], Content ). count_coins( Part, Coins, Count ) :- part( Part, Coins, Selection ), length( Selection, Count ). </pre> === Updating what is known about the coins === ====draw_inferences( +Result, +Left, +Right, +Table, ?Coins )==== holds when <var>Result</var> is one of: * > (imbalance &ndash; left pan heavier), * < (imbalance &ndash; right pan heavier) or * <nowiki>=</nowiki> (pans balanced) from taking a weighing with the coin collections: <var>Left</var>, <var>Right</var> and <var>Table</var>. <var>Coins</var> is derived from this information using the following rules: * If the pans are unbalanced then only the previously untested or not_heavy coins on the lighter side of the balance are now not_heavy. Similarly, only the previously untested or not_light coins on the heavier side of the balance are now not_light. All the coins on the table are now known_true. * If the pans balance then all the coins weighed are known_true, with the coins on the <var>Table</var> left in their prior states. <pre class="prolog"> draw_inferences( <, Left, Right, Table, Coins ) :- imbalance_inferences( Left, Right, Table, Coins ). draw_inferences( >, Left, Right, Table, Coins ) :- imbalance_inferences( Right, Left, Table, Coins ). draw_inferences( =, Left, Right, Table, Coins ) :- becomes( [all(Left),known_true(Table),all(Right)], known_true( Coins ) ), becomes( untested(Table), untested(Coins) ), becomes( not_heavy(Table), not_heavy(Coins) ), becomes( not_light(Table), not_light(Coins) ). </pre> ====imbalance_inferences( +Lighter, +Heavier, +Table, ?Coins )==== holds when: * Only the untested or not_heavy coins in <var>Lighter</var> are not_heavy in <var>Coins</var>; * Only the untested or not_light coins in <var>Heavier</var> are not_light in <var>Coins</var>; * All the other coins in <var>Lighter</var> and <var>Heavier</var> and all the coins in <var>Table</var> are known_true in <var>Coins</var>; There are no untested coins in <var>Coins</var>. <pre class="prolog"> imbalance_inferences( Lighter, Heavier, Table, Coins ) :- becomes( [untested(Lighter),not_heavy(Lighter)], not_heavy(Coins) ), becomes( [untested(Heavier),not_light(Heavier)], not_light(Coins) ), becomes( [ known_true(Lighter), not_light(Lighter), known_true(Heavier), not_heavy(Heavier), all(Table) ], known_true(Coins) ), part( untested, Coins, [] ). </pre> ====becomes( +CollectionA, ?CollectionB )==== <var>CollectionA</var> becomes (part) <var>CollectionB</var> when <var>CollectionB</var> comprises the same coins as <var>CollectionA</var>. <pre class="prolog"> becomes( CollectionA, CollectionB ) :- unfolded( CollectionA, Coins ), unfolded( CollectionB, Coins ). </pre> ====unfolded( +Collection, ?Coins )==== holds when (part) <var>Collection</var> comprises <var>Coins</var>. <pre class="prolog"> unfolded( not_light(Collection), Coins ) :- part( not_light, Collection, Coins ). unfolded( not_heavy(Collection), Coins ) :- part( not_heavy, Collection, Coins ). unfolded( known_true(Collection), Coins ) :- part( known_true, Collection, Coins ). unfolded( untested(Collection), Coins ) :- part( untested, Collection, Coins ). unfolded( all(Collection), Coins ) :- collection_to_set( Collection, Coins ). unfolded( [Item|Items], Coins ) :- unfolded( Item, Value ), unfolded1( Items, Value, Coins ). unfolded1( [], Coins, Coins ). unfolded1( [Item|Items], Value, Coins ) :- unfolded( Item, Value0 ), ord_union( Value0, Value, Value1 ), unfolded1( Items, Value1, Coins ). </pre> ==Definite Clause Grammar== The following DCG represents the method for finding the counterfeit coin as a structured procedure. <pre class="prolog"> general_explanation( Procedure ) --> "Number the coins 1..12", newline, explanation( Procedure, 0 ). explanation( done(Coin, Weight), N ) --> tab( N ), "Conclude that the counterfeit coin is number ", literal( Coin ), ", which is ", literal( Weight ), newline. explanation( Step, N ) --> {step( Step, Left, Right, Table, Branches )}, tab( N ), "BEGIN", newline, tab( N ), "Put ", literal( Left ), " on the left-hand pan", newline, tab( N ), "Put ", literal( Right ), " on the right-hand pan", newline, tab( N ), "Leaving ", literal( Table ), " on the table", newline, branches_explained( Branches, N ), tab( N ), "END", newline. branches_explained( Branches, N ) --> next_step_explained( <, Branches, N ), next_step_explained( >, Branches, N ), next_step_explained( =, Branches, N ). next_step_explained( Result, Branch, N ) --> {branch( Result, Branch, Step )}, ( {var(Step)} -> "" | {nonvar(Step)} -> tab( N ), "If the ", literal( Result ), " then:", newline, explanation( Step, s(N) ) ). literal( 0 ) --> "0". literal( 1 ) --> "1". literal( 2 ) --> "2". literal( 3 ) --> "3". literal( 4 ) --> "4". literal( 5 ) --> "5". literal( 6 ) --> "6". literal( 7 ) --> "7". literal( 8 ) --> "8". literal( 9 ) --> "9". literal( 10 ) --> "10". literal( 11 ) --> "11". literal( 12 ) --> "12". literal( true ) --> "true". literal( heavy ) --> "heavy". literal( light ) --> "light". literal( = ) --> "pans balance". literal( < ) --> "right-hand pan is heavier". literal( > ) --> "left-hand pan is heavier". literal( Collection ) --> {collection_to_set( Collection , [H|T] )}, literal_set( T, H ). literal_set( [], Number ) --> "the coin numbered ", literal( Number ). literal_set( [H|T], Number ) --> "the coins numbered ", literal( Number ), literal_set1( T, H ). literal_set1( [], Number ) --> " and ", literal( Number ). literal_set1( [H|T], Number ) --> ", ", literal( Number ), literal_set1( T, H ). tab( 0 ) --> "". tab( s(N) ) --> " ", tab( N ). newline --> " ". </pre> ===Utility Predicates=== ====contains_coin( ?Collection, ?Coin )==== holds when <var>Coin</var> is a member of <var>Collection</var>. <pre class="prolog"> contains_coin( Collection, Coin ) :- part( _Part, Collection, Coins ), member( Coin, Coins ). </pre> ====collection_to_set( +Collection, ?Set )==== holds when <var>Set</var> is the distributed union of the <code>known_true</code>, <code>not_heavy</code>, <code>not_light</code> and <code>untested</code> ordsets comprising <var>Collection</var>. <pre class="prolog"> collection_to_set( Collection, Set ) :- part( known_true, Collection, KnownTrue ), part( not_heavy, Collection, NotHeavy ), part( not_light, Collection, NotLight ), part( untested, Collection, Untested ), ord_union( [KnownTrue,NotHeavy,NotLight,Untested], Set ). </pre> ===Information Content=== ==== information_content( +Counts, ?Content ) ==== holds when <var>Content</var> is the cumulative negative entropy of <var>Counts</var>. A reduction in entropy equates to a gain in information. <pre class="prolog"> information_content( Counts, Content ) :- information_content1( Counts, 0, Content ). information_content1( [], Content, Content ). information_content1( [Count|Counts], Content0, Content ):- coins_entropy( Count, Entropy ), Content1 is Content0-Entropy, information_content1( Counts, Content1, Content ). </pre> ==== coins_entropy( ?N, ?Entropy ) ==== holds when <var>Entropy</var> estimates the entropy of a sample of <var>N</var> coins. <var>Entropy</var> = P log₂(¹&frasl;_P), where P = <var>N</var>&divide;12. <pre class="prolog"> coins_entropy( 0, 0.0 ). coins_entropy( 1, 0.2987 ). coins_entropy( 2, 0.4308 ). coins_entropy( 3, 0.5 ). coins_entropy( 4, 0.5283 ). coins_entropy( 5, 0.5263 ). coins_entropy( 6, 0.5 ). coins_entropy( 7, 0.4536 ). coins_entropy( 8, 0.39 ). coins_entropy( 9, 0.3113 ). coins_entropy( 10, 0.2192 ). coins_entropy( 11, 0.1151 ). coins_entropy( 12, 0.0 ). </pre> ====select_coins( +Part, +Coins, ?Sample, ?Residue, ?N )==== holds when <var>N</var> coins from <var>Part</var> of <var>Coins</var> form <var>Part</var> of <var>Sample</var>, with the remainder forming <var>Part</var> of <var>Residue</var>. <pre class="prolog"> select_coins( Part, Coins, Sample, Residue, Count ) :- part( Part, Coins, Input ), part( Part, Sample, Selection ), part( Part, Residue, Remainder ), select_n( Count, Input, Selection, Remainder ). select_n( 0, In, [], In ). select_n( 1, [A|Suffix], [A], Suffix ). select_n( 2, [A,B|Suffix], [A,B], Suffix ). select_n( 3, [A,B,C|Suffix], [A,B,C], Suffix ). select_n( 4, [A,B,C,D|Suffix], [A,B,C,D], Suffix ). select_n( 5, [A,B,C,D,E|Suffix], [A,B,C,D,E], Suffix ). select_n( 6, [A,B,C,D,E,F|Suffix], [A,B,C,D,E,F], Suffix ). </pre> Load a small library of [[Puzzle Utilities]]. <pre class="prolog"> :- ensure_loaded( misc ). </pre> Use the ordsets library. <pre class="prolog"> :- use_module( library(ordsets), [ord_union/2,ord_union/3] ). </pre> The code is available as plain text [https://binding-time.co.uk/download/counterfeit.txt here]. ==Output== <div class="result"> Number the coins 1..12 BEGIN Put the coins numbered 1, 2, 3 and 4 on the left-hand pan Put the coins numbered 5, 6, 7 and 8 on the right-hand pan Leaving the coins numbered 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 1, 2, 5 and 6 on the left-hand pan Put the coins numbered 3, 7, 9 and 10 on the right-hand pan Leaving the coins numbered 4, 8, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 1 and 7 on the left-hand pan Put the coins numbered 3 and 4 on the right-hand pan Leaving the coins numbered 2, 5, 6, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 1, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 7, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 2, which is light END If the left-hand pan is heavier then: BEGIN Put the coins numbered 3 and 5 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 4, 6, 7, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 3, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 5, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 6, which is heavy END If the pans balance then: BEGIN Put the coins numbered 4 and 8 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 3, 5, 6, 7, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 4, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 8, which is heavy END END If the left-hand pan is heavier then: BEGIN Put the coins numbered 1, 2, 5 and 6 on the left-hand pan Put the coins numbered 3, 7, 9 and 10 on the right-hand pan Leaving the coins numbered 4, 8, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 3 and 5 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 4, 6, 7, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 5, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 3, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 6, which is light END If the left-hand pan is heavier then: BEGIN Put the coins numbered 1 and 7 on the left-hand pan Put the coins numbered 3 and 4 on the right-hand pan Leaving the coins numbered 2, 5, 6, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 7, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 1, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 2, which is heavy END If the pans balance then: BEGIN Put the coins numbered 4 and 8 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 3, 5, 6, 7, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 8, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 4, which is heavy END END If the pans balance then: BEGIN Put the coins numbered 9, 10 and 11 on the left-hand pan Put the coins numbered 1, 2 and 3 on the right-hand pan Leaving the coins numbered 4, 5, 6, 7, 8 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coin numbered 9 on the left-hand pan Put the coin numbered 10 on the right-hand pan Leaving the coins numbered 1, 2, 3, 4, 5, 6, 7, 8, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 9, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 10, which is light If the pans balance then: Conclude that the counterfeit coin is number 11, which is light END If the left-hand pan is heavier then: BEGIN Put the coin numbered 9 on the left-hand pan Put the coin numbered 10 on the right-hand pan Leaving the coins numbered 1, 2, 3, 4, 5, 6, 7, 8, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 10, which is heavy If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 9, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 11, which is heavy END If the pans balance then: BEGIN Put the coin numbered 12 on the left-hand pan Put the coin numbered 1 on the right-hand pan Leaving the coins numbered 2, 3, 4, 5, 6, 7, 8, 9, 10 and 11 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 12, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 12, which is heavy END END END </div> ---- 1b67eb30fbe31fa2a2c201e4efaf5c040b6deb79 191 190 2017-02-21T14:58:26Z John 2 /* Definite Clause Grammar */ wikitext text/x-wiki __NOTOC__ ==Problem Definition== We are given 12 apparently identical coins - one of which is counterfeit. We know that the counterfeit has a different weight from the others, but we don't know if it's heavier or lighter. ===Task:=== Devise a procedure to identify any counterfeit coin using a balance to take up to three comparative weighings. ==Strategy== The information from three suitable weighings will make all but one of the coins, which are untested initially, known_true. There are three alternative deductions that make a coin known_true: * if it is not_heavy and not_light &ndash; having been on both the comparatively lighter and heavier sides of imbalances; * if it was excluded from an imbalance; * if it was included in a balanced weighing. After three weighings there must be exactly one coin, the counterfeit, which is not known_true. If the counterfeit is not known_true and not_heavy we deduce that it must be light. If it is not known_true and not_light, it must be heavy. We use a generate-and-test method as follows: * Create the set of all possible counterfeits: 12 coins &times; 2 weights ; * Devise a procedure that can identify the first counterfeit coin; * Show that the same procedure works for every other counterfeit coin. ==Entry Point== ====go==== is the entry point. It solves the puzzle, then uses a DCG to pretty-print the resulting procedure. <pre class="prolog"> go :- coins_puzzle( Procedure ), phrase( general_explanation( Procedure ), Chars ), put_chars( Chars ). </pre> ====coins_puzzle( ?Procedure )==== generates the set of all possible counterfeit coins and finds, or proves, that <var>Procedure</var> can identify them all. <pre class="prolog"> coins_puzzle( Procedure ) :- coins( Coins ), counterfeit( Counterfeit, Coin, Weight ), findall( Counterfeit, (member(Coin,Coins), counterfeit_weight(Weight)), Counterfeits ), coins_puzzle_solution( Counterfeits, Procedure ). coins_puzzle_solution( [], _Procedure ). coins_puzzle_solution( [Counterfeit|Counterfeits], Procedure ) :- solve_coins( Counterfeit, Procedure ), coins_puzzle_solution( Counterfeits, Procedure ). </pre> A procedure is either ''done'', identifying a particular coin and whether it is heavy or light, or it is a ''step''. A ''step'' defines the coins to be placed on the <var>Left</var> and <var>Right</var> pans, with the residue remaining on the <var>Table</var>, and three <var>Branches</var>, one of which will be chosen depending on the outcome of the weighing. <pre class="prolog"> step( step(Left,Right,Table,Branches), Left, Right, Table, Branches). </pre> The <var>Branches</var> are three procedures equating to: * > (left pan heavier), * < (right pan heavier) and * <nowiki>= (pans balance).</nowiki> <pre class="prolog"> branch( >, branches(_Equal, GT, _LT), GT ). branch( <, branches(_Equal, _GT, LT), LT ). branch( =, branches(Equal, _GT, _LT), Equal ). </pre> The counterfeit is defined by its number and whether it is heavy or light. <pre class="prolog"> counterfeit( counterfeit(Coin, HeavyOrLight), Coin, HeavyOrLight ). coins( [1,2,3,4,5,6,7,8,9,10,11,12] ). counterfeit_weight( heavy ). counterfeit_weight( light ). </pre> A ''coin collection'' comprises four <code>part</code>s (subsets): the <code>known_true</code>, <code>not_heavy</code>, <code>not_light</code> and <code>untested</code> sets of coins. <pre class="prolog"> part( known_true, collection(Coins,_,_,_), Coins ). part( not_heavy, collection(_,Coins,_,_), Coins ). part( not_light, collection(_,_,Coins,_), Coins ). part( untested, collection(_,_,_,Coins), Coins ). </pre> ==Solution== ====solve_coins( +Counterfeit, ?Procedure )==== holds when <var>Procedure</var> can correctly identify the <var>Counterfeit</var> coin. Beginning with a ''start'' collection, in which all the coins are untested, the <var>Procedure</var> comprises three steps. For each step, a weighing is made and a ''branch'' is made in the <var>Procedure</var>, depending on the result of the weighing. After three steps, the <var>Procedure</var> must have reached the ''end'' condition. Finally, an assertion (redundant test) ensures that the <var>Procedure</var> has found the correct ''end'' condition. <pre class="prolog"> solve_coins( Counterfeit, Procedure ) :- start( Coins0 ), assay( Counterfeit, Coins0, Procedure, Branch1, Coins1 ), assay( Counterfeit, Coins1, Branch1, Branch2, Coins2 ), assay( Counterfeit, Coins2, Branch2, done(Coin, HeavyOrLight), Coins3 ), end( Coins3, Coin, HeavyOrLight ), counterfeit( Counterfeit, Coin, HeavyOrLight ). start( Coins ) :- coins( Untested ), part( untested, Coins, Untested ), part( not_heavy, Coins, [] ), part( not_light, Coins, [] ), part( known_true, Coins, [] ). end( Coins, Coin, HeavyOrLight ) :- part( untested, Coins, [] ), part( not_heavy, Coins, Light ), part( not_light, Coins, Heavy ), end_result( Heavy, Light, Coin, HeavyOrLight ). end_result( [Coin], [], Coin, heavy ). end_result( [], [Coin], Coin, light ). </pre> === Simulating the weighing process === ====assay( +Counterfeit, +Coins0, ?Step, ?Branch, ?Coins1 )==== holds when the appropriate <var>Branch</var> from <var>Step</var> is chosen by comparing the weights of two coin collections taken from the full set of coins: <var>Coins0</var>. <var>Coins1</var> is the full set of coins updated with the inferences drawn from the weighing, where <var>Counterfeit</var> is used to determine the result of the weighing. This predicate applies the critical insight into the solution of this puzzle: we have 24 (12 &times; 2) possible inputs to the procedure, with only 27 (3 &times; 3 &times; 3) possible outcomes from the weighings. Therefore, it is clear that each weighing must have a very high [[#Information Content|information content]]. Choosing which weighing to make by estimating the available information content makes the problem tractable. <pre class="prolog"> assay( Counterfeit, Coins0, Step, Branch, Coins ) :- WeighingDatum = weighing_data(InfoContent, Left, Right, Table), step( Step, Left, Right, Table, Branches ), findall( WeighingDatum, valid_partition( Coins0, InfoContent, Left, Right, Table ), WeighingData ), sort( WeighingData, OrderedWeighingData ), member( WeighingDatum, OrderedWeighingData ), balance( Left, Right, Counterfeit, Result ), draw_inferences( Result, Left, Right, Table, Coins ), branch( Result, Branches, Branch ). </pre> ====balance( +Left, +Right, +Counterfeit, ?Result )==== holds when <var>Result</var> simulates the outcome of testing the coin collections <var>Left</var> and <var>Right</var> with a balance, where either may contain the <var>Counterfeit</var> coin. <pre class="prolog"> balance( Left, Right, Counterfeit, Result ):- counterfeit( Counterfeit, Coin, Weight ), ( contains_coin( Left, Coin ) -> balance_result( Weight, normal, Result ) ; contains_coin( Right, Coin ) -> balance_result( normal, Weight, Result ) ; otherwise -> Result = '=' ). balance_result( light, normal, < ). balance_result( heavy, normal, > ). balance_result( normal, heavy, < ). balance_result( normal, light, > ). </pre> ===Choosing which coins to weigh=== ====valid_partition( +Coins, ?Content, ?Left, ?Right, ?Table )==== holds when <var>Coins</var> can be partitioned into three collections: <var>Left</var> side, <var>Right</var> side and <var>Table</var>; with the information content of the partition given by <var>Content</var>. The definition of a valid_partition ensures that: * <var>Left</var> and <var>Right</var> must have the same number of coins (at least one); * <var>Left</var> cannot contain any known_true coins, because adding true coins to both sides creates redundant comparisons; * Comparisons between mixtures of coins where only the choice of pans is different are equivalent, so a partial order (&ge;) on mixtures of coins is used to eliminate some redundant comparisons. <pre class="prolog"> valid_partition( Coins, Content, Left, Right, Table ):- part( known_true, Left, [] ), selection( Coins, Left, Coins1, LeftSum, LeftInfo ), selection( Coins1, Right, Table, RightSum, RightInfo ), LeftSum =:= RightSum, LeftSum @>= RightSum, table_information( Table, TableInfo ), sum( [LeftInfo,RightInfo,TableInfo], Content ). </pre> ====selection( +Coins, ?Sample, ?Residue, ?Sum, ?Content )==== holds when <var>Coins</var> is partitioned into two collections: <var>Sample</var> and <var>Residue</var>. <var>Sum</var> is used as both a fingerprint for the mixture of coins in <var>Sample</var> and a representation of the number of coins in <var>Sample</var>. <var>Content</var> estimates the information-content of <var>Sample</var>. <pre class="prolog"> selection( Coins, Sample, Residue, Sum, Content ) :- Sum = Count1+Count2+Count3+Count4, select_coins( not_heavy, Coins, Sample, Residue, Count1 ), select_coins( not_light, Coins, Sample, Residue, Count2 ), select_coins( untested, Coins, Sample, Residue, Count3 ), select_coins( known_true, Coins, Sample, Residue, Count4 ), Sum >= 1, Sum =< 6, information_content( [Count1,Count2,Count3,Count4], Content ). </pre> ====table_information( +Coins, ?Content )==== holds when <var>Coins</var> has 'information content' <var>Content</var>. <pre class="prolog"> table_information( Coins, Content ) :- count_coins( not_heavy, Coins, Count1 ), count_coins( not_light, Coins, Count2 ), count_coins( untested, Coins, Count3 ), count_coins( known_true, Coins, Count4 ), information_content( [Count1,Count2,Count3,Count4], Content ). count_coins( Part, Coins, Count ) :- part( Part, Coins, Selection ), length( Selection, Count ). </pre> === Updating what is known about the coins === ====draw_inferences( +Result, +Left, +Right, +Table, ?Coins )==== holds when <var>Result</var> is one of: * > (imbalance &ndash; left pan heavier), * < (imbalance &ndash; right pan heavier) or * <nowiki>=</nowiki> (pans balanced) from taking a weighing with the coin collections: <var>Left</var>, <var>Right</var> and <var>Table</var>. <var>Coins</var> is derived from this information using the following rules: * If the pans are unbalanced then only the previously untested or not_heavy coins on the lighter side of the balance are now not_heavy. Similarly, only the previously untested or not_light coins on the heavier side of the balance are now not_light. All the coins on the table are now known_true. * If the pans balance then all the coins weighed are known_true, with the coins on the <var>Table</var> left in their prior states. <pre class="prolog"> draw_inferences( <, Left, Right, Table, Coins ) :- imbalance_inferences( Left, Right, Table, Coins ). draw_inferences( >, Left, Right, Table, Coins ) :- imbalance_inferences( Right, Left, Table, Coins ). draw_inferences( =, Left, Right, Table, Coins ) :- becomes( [all(Left),known_true(Table),all(Right)], known_true( Coins ) ), becomes( untested(Table), untested(Coins) ), becomes( not_heavy(Table), not_heavy(Coins) ), becomes( not_light(Table), not_light(Coins) ). </pre> ====imbalance_inferences( +Lighter, +Heavier, +Table, ?Coins )==== holds when: * Only the untested or not_heavy coins in <var>Lighter</var> are not_heavy in <var>Coins</var>; * Only the untested or not_light coins in <var>Heavier</var> are not_light in <var>Coins</var>; * All the other coins in <var>Lighter</var> and <var>Heavier</var> and all the coins in <var>Table</var> are known_true in <var>Coins</var>; There are no untested coins in <var>Coins</var>. <pre class="prolog"> imbalance_inferences( Lighter, Heavier, Table, Coins ) :- becomes( [untested(Lighter),not_heavy(Lighter)], not_heavy(Coins) ), becomes( [untested(Heavier),not_light(Heavier)], not_light(Coins) ), becomes( [ known_true(Lighter), not_light(Lighter), known_true(Heavier), not_heavy(Heavier), all(Table) ], known_true(Coins) ), part( untested, Coins, [] ). </pre> ====becomes( +CollectionA, ?CollectionB )==== <var>CollectionA</var> becomes (part) <var>CollectionB</var> when <var>CollectionB</var> comprises the same coins as <var>CollectionA</var>. <pre class="prolog"> becomes( CollectionA, CollectionB ) :- unfolded( CollectionA, Coins ), unfolded( CollectionB, Coins ). </pre> ====unfolded( +Collection, ?Coins )==== holds when (part) <var>Collection</var> comprises <var>Coins</var>. <pre class="prolog"> unfolded( not_light(Collection), Coins ) :- part( not_light, Collection, Coins ). unfolded( not_heavy(Collection), Coins ) :- part( not_heavy, Collection, Coins ). unfolded( known_true(Collection), Coins ) :- part( known_true, Collection, Coins ). unfolded( untested(Collection), Coins ) :- part( untested, Collection, Coins ). unfolded( all(Collection), Coins ) :- collection_to_set( Collection, Coins ). unfolded( [Item|Items], Coins ) :- unfolded( Item, Value ), unfolded1( Items, Value, Coins ). unfolded1( [], Coins, Coins ). unfolded1( [Item|Items], Value, Coins ) :- unfolded( Item, Value0 ), ord_union( Value0, Value, Value1 ), unfolded1( Items, Value1, Coins ). </pre> ==Definite Clause Grammar== The following DCG presents the method for finding the counterfeit coin as a structured procedure. <pre class="prolog"> general_explanation( Procedure ) --> "Number the coins 1..12", newline, explanation( Procedure, 0 ). explanation( done(Coin, Weight), N ) --> tab( N ), "Conclude that the counterfeit coin is number ", literal( Coin ), ", which is ", literal( Weight ), newline. explanation( Step, N ) --> {step( Step, Left, Right, Table, Branches )}, tab( N ), "BEGIN", newline, tab( N ), "Put ", literal( Left ), " on the left-hand pan", newline, tab( N ), "Put ", literal( Right ), " on the right-hand pan", newline, tab( N ), "Leaving ", literal( Table ), " on the table", newline, branches_explained( Branches, N ), tab( N ), "END", newline. branches_explained( Branches, N ) --> next_step_explained( <, Branches, N ), next_step_explained( >, Branches, N ), next_step_explained( =, Branches, N ). next_step_explained( Result, Branch, N ) --> {branch( Result, Branch, Step )}, ( {var(Step)} -> "" | {nonvar(Step)} -> tab( N ), "If the ", literal( Result ), " then:", newline, explanation( Step, s(N) ) ). literal( 0 ) --> "0". literal( 1 ) --> "1". literal( 2 ) --> "2". literal( 3 ) --> "3". literal( 4 ) --> "4". literal( 5 ) --> "5". literal( 6 ) --> "6". literal( 7 ) --> "7". literal( 8 ) --> "8". literal( 9 ) --> "9". literal( 10 ) --> "10". literal( 11 ) --> "11". literal( 12 ) --> "12". literal( true ) --> "true". literal( heavy ) --> "heavy". literal( light ) --> "light". literal( = ) --> "pans balance". literal( < ) --> "right-hand pan is heavier". literal( > ) --> "left-hand pan is heavier". literal( Collection ) --> {collection_to_set( Collection , [H|T] )}, literal_set( T, H ). literal_set( [], Number ) --> "the coin numbered ", literal( Number ). literal_set( [H|T], Number ) --> "the coins numbered ", literal( Number ), literal_set1( T, H ). literal_set1( [], Number ) --> " and ", literal( Number ). literal_set1( [H|T], Number ) --> ", ", literal( Number ), literal_set1( T, H ). tab( 0 ) --> "". tab( s(N) ) --> " ", tab( N ). newline --> " ". </pre> ===Utility Predicates=== ====contains_coin( ?Collection, ?Coin )==== holds when <var>Coin</var> is a member of <var>Collection</var>. <pre class="prolog"> contains_coin( Collection, Coin ) :- part( _Part, Collection, Coins ), member( Coin, Coins ). </pre> ====collection_to_set( +Collection, ?Set )==== holds when <var>Set</var> is the distributed union of the <code>known_true</code>, <code>not_heavy</code>, <code>not_light</code> and <code>untested</code> ordsets comprising <var>Collection</var>. <pre class="prolog"> collection_to_set( Collection, Set ) :- part( known_true, Collection, KnownTrue ), part( not_heavy, Collection, NotHeavy ), part( not_light, Collection, NotLight ), part( untested, Collection, Untested ), ord_union( [KnownTrue,NotHeavy,NotLight,Untested], Set ). </pre> ===Information Content=== ==== information_content( +Counts, ?Content ) ==== holds when <var>Content</var> is the cumulative negative entropy of <var>Counts</var>. A reduction in entropy equates to a gain in information. <pre class="prolog"> information_content( Counts, Content ) :- information_content1( Counts, 0, Content ). information_content1( [], Content, Content ). information_content1( [Count|Counts], Content0, Content ):- coins_entropy( Count, Entropy ), Content1 is Content0-Entropy, information_content1( Counts, Content1, Content ). </pre> ==== coins_entropy( ?N, ?Entropy ) ==== holds when <var>Entropy</var> estimates the entropy of a sample of <var>N</var> coins. <var>Entropy</var> = P log₂(¹&frasl;_P), where P = <var>N</var>&divide;12. <pre class="prolog"> coins_entropy( 0, 0.0 ). coins_entropy( 1, 0.2987 ). coins_entropy( 2, 0.4308 ). coins_entropy( 3, 0.5 ). coins_entropy( 4, 0.5283 ). coins_entropy( 5, 0.5263 ). coins_entropy( 6, 0.5 ). coins_entropy( 7, 0.4536 ). coins_entropy( 8, 0.39 ). coins_entropy( 9, 0.3113 ). coins_entropy( 10, 0.2192 ). coins_entropy( 11, 0.1151 ). coins_entropy( 12, 0.0 ). </pre> ====select_coins( +Part, +Coins, ?Sample, ?Residue, ?N )==== holds when <var>N</var> coins from <var>Part</var> of <var>Coins</var> form <var>Part</var> of <var>Sample</var>, with the remainder forming <var>Part</var> of <var>Residue</var>. <pre class="prolog"> select_coins( Part, Coins, Sample, Residue, Count ) :- part( Part, Coins, Input ), part( Part, Sample, Selection ), part( Part, Residue, Remainder ), select_n( Count, Input, Selection, Remainder ). select_n( 0, In, [], In ). select_n( 1, [A|Suffix], [A], Suffix ). select_n( 2, [A,B|Suffix], [A,B], Suffix ). select_n( 3, [A,B,C|Suffix], [A,B,C], Suffix ). select_n( 4, [A,B,C,D|Suffix], [A,B,C,D], Suffix ). select_n( 5, [A,B,C,D,E|Suffix], [A,B,C,D,E], Suffix ). select_n( 6, [A,B,C,D,E,F|Suffix], [A,B,C,D,E,F], Suffix ). </pre> Load a small library of [[Puzzle Utilities]]. <pre class="prolog"> :- ensure_loaded( misc ). </pre> Use the ordsets library. <pre class="prolog"> :- use_module( library(ordsets), [ord_union/2,ord_union/3] ). </pre> The code is available as plain text [https://binding-time.co.uk/download/counterfeit.txt here]. ==Output== <div class="result"> Number the coins 1..12 BEGIN Put the coins numbered 1, 2, 3 and 4 on the left-hand pan Put the coins numbered 5, 6, 7 and 8 on the right-hand pan Leaving the coins numbered 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 1, 2, 5 and 6 on the left-hand pan Put the coins numbered 3, 7, 9 and 10 on the right-hand pan Leaving the coins numbered 4, 8, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 1 and 7 on the left-hand pan Put the coins numbered 3 and 4 on the right-hand pan Leaving the coins numbered 2, 5, 6, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 1, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 7, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 2, which is light END If the left-hand pan is heavier then: BEGIN Put the coins numbered 3 and 5 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 4, 6, 7, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 3, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 5, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 6, which is heavy END If the pans balance then: BEGIN Put the coins numbered 4 and 8 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 3, 5, 6, 7, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 4, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 8, which is heavy END END If the left-hand pan is heavier then: BEGIN Put the coins numbered 1, 2, 5 and 6 on the left-hand pan Put the coins numbered 3, 7, 9 and 10 on the right-hand pan Leaving the coins numbered 4, 8, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 3 and 5 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 4, 6, 7, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 5, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 3, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 6, which is light END If the left-hand pan is heavier then: BEGIN Put the coins numbered 1 and 7 on the left-hand pan Put the coins numbered 3 and 4 on the right-hand pan Leaving the coins numbered 2, 5, 6, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 7, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 1, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 2, which is heavy END If the pans balance then: BEGIN Put the coins numbered 4 and 8 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 3, 5, 6, 7, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 8, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 4, which is heavy END END If the pans balance then: BEGIN Put the coins numbered 9, 10 and 11 on the left-hand pan Put the coins numbered 1, 2 and 3 on the right-hand pan Leaving the coins numbered 4, 5, 6, 7, 8 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coin numbered 9 on the left-hand pan Put the coin numbered 10 on the right-hand pan Leaving the coins numbered 1, 2, 3, 4, 5, 6, 7, 8, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 9, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 10, which is light If the pans balance then: Conclude that the counterfeit coin is number 11, which is light END If the left-hand pan is heavier then: BEGIN Put the coin numbered 9 on the left-hand pan Put the coin numbered 10 on the right-hand pan Leaving the coins numbered 1, 2, 3, 4, 5, 6, 7, 8, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 10, which is heavy If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 9, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 11, which is heavy END If the pans balance then: BEGIN Put the coin numbered 12 on the left-hand pan Put the coin numbered 1 on the right-hand pan Leaving the coins numbered 2, 3, 4, 5, 6, 7, 8, 9, 10 and 11 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 12, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 12, which is heavy END END END </div> ---- bcb2ea8200f2a91df3fdb6c4092f9518fedb413f 199 191 2017-11-23T22:48:53Z John 2 partition/4 defined to aid readability. wikitext text/x-wiki __NOTOC__ ==Problem Definition== We are given 12 apparently identical coins - one of which is counterfeit. We know that the counterfeit has a different weight from the others, but we don't know if it's heavier or lighter. ===Task:=== Devise a procedure to identify any counterfeit coin using a balance to take up to three comparative weighings. ==Strategy== The information from three suitable weighings will make all but one of the coins, which are untested initially, known_true. There are three alternative deductions that make a coin known_true: * if it is not_heavy and not_light &ndash; having been on both the comparatively lighter and heavier sides of imbalances; * if it was excluded from an imbalance; * if it was included in a balanced weighing. After three weighings there must be exactly one coin, the counterfeit, which is not known_true. If the counterfeit is not known_true and not_heavy we deduce that it must be light. If it is not known_true and not_light, it must be heavy. We use a generate-and-test method as follows: * Create the set of all possible counterfeits: 12 coins &times; 2 weights ; * Devise a procedure that can identify the first counterfeit coin; * Show that the same procedure works for every other counterfeit coin. ==Entry Point== ====go==== is the entry point. It solves the puzzle, then uses a DCG to pretty-print the resulting procedure. <pre class="prolog"> go :- coins_puzzle( Procedure ), phrase( general_explanation( Procedure ), Chars ), put_chars( Chars ). </pre> ====coins_puzzle( ?Procedure )==== generates the set of all possible counterfeit coins and finds, or proves, that <var>Procedure</var> can identify them all. <pre class="prolog"> coins_puzzle( Procedure ) :- coins( Coins ), counterfeit( Counterfeit, Coin, Weight ), findall( Counterfeit, (member(Coin,Coins), counterfeit_weight(Weight)), Counterfeits ), coins_puzzle_solution( Counterfeits, Procedure ). coins_puzzle_solution( [], _Procedure ). coins_puzzle_solution( [Counterfeit|Counterfeits], Procedure ) :- solve_coins( Counterfeit, Procedure ), coins_puzzle_solution( Counterfeits, Procedure ). </pre> A procedure is either ''done'', identifying a particular coin and whether it is heavy or light, or it is a ''step''. A ''step'' defines the coins to be placed on the <var>Left</var> and <var>Right</var> pans, with the residue remaining on the <var>Table</var>, and three <var>Branches</var>, one of which will be chosen depending on the outcome of the weighing. <pre class="prolog"> step( step(Left,Right,Table,Branches), Left, Right, Table, Branches). </pre> The <var>Branches</var> are three procedures equating to: * > (left pan heavier), * < (right pan heavier) and * <nowiki>= (pans balance).</nowiki> <pre class="prolog"> branch( >, branches(_Equal, GT, _LT), GT ). branch( <, branches(_Equal, _GT, LT), LT ). branch( =, branches(Equal, _GT, _LT), Equal ). </pre> The counterfeit is defined by its number and whether it is heavy or light. <pre class="prolog"> counterfeit( counterfeit(Coin, HeavyOrLight), Coin, HeavyOrLight ). coins( [1,2,3,4,5,6,7,8,9,10,11,12] ). counterfeit_weight( heavy ). counterfeit_weight( light ). </pre> A ''coin collection'' comprises four <code>part</code>s (subsets): the <code>known_true</code>, <code>not_heavy</code>, <code>not_light</code> and <code>untested</code> sets of coins. <pre class="prolog"> part( known_true, collection(Coins,_,_,_), Coins ). part( not_heavy, collection(_,Coins,_,_), Coins ). part( not_light, collection(_,_,Coins,_), Coins ). part( untested, collection(_,_,_,Coins), Coins ). </pre> ==Solution== ====solve_coins( +Counterfeit, ?Procedure )==== holds when <var>Procedure</var> can correctly identify the <var>Counterfeit</var> coin. Beginning with a ''start'' collection, in which all the coins are untested, the <var>Procedure</var> comprises three steps. For each step, a weighing is made and a ''branch'' is made in the <var>Procedure</var>, depending on the result of the weighing. After three steps, the <var>Procedure</var> must have reached the ''end'' condition. Finally, an assertion (redundant test) ensures that the <var>Procedure</var> has found the correct ''end'' condition. <pre class="prolog"> solve_coins( Counterfeit, Procedure ) :- start( Coins0 ), assay( Counterfeit, Coins0, Procedure, Branch1, Coins1 ), assay( Counterfeit, Coins1, Branch1, Branch2, Coins2 ), assay( Counterfeit, Coins2, Branch2, done(Coin, HeavyOrLight), Coins3 ), end( Coins3, Coin, HeavyOrLight ), counterfeit( Counterfeit, Coin, HeavyOrLight ). start( Coins ) :- coins( Untested ), part( untested, Coins, Untested ), part( not_heavy, Coins, [] ), part( not_light, Coins, [] ), part( known_true, Coins, [] ). end( Coins, Coin, HeavyOrLight ) :- part( untested, Coins, [] ), part( not_heavy, Coins, Light ), part( not_light, Coins, Heavy ), end_result( Heavy, Light, Coin, HeavyOrLight ). end_result( [Coin], [], Coin, heavy ). end_result( [], [Coin], Coin, light ). </pre> === Simulating the weighing process === ====assay( +Counterfeit, +Coins0, ?Step, ?Branch, ?Coins1 )==== holds when the appropriate <var>Branch</var> from <var>Step</var> is chosen by comparing the weights of two coin collections taken from the full set of coins: <var>Coins0</var>. <var>Coins1</var> is the full set of coins updated with the inferences drawn from the weighing, where <var>Counterfeit</var> is used to determine the result of the weighing. This predicate applies the critical insight into the solution of this puzzle: we have 24 (12 &times; 2) possible inputs to the procedure, with only 27 (3 &times; 3 &times; 3) possible outcomes from the weighings. Therefore, it is clear that each weighing must have a very high [[#Information Content|information content]]. Choosing which weighing to make by estimating the available information content makes the problem tractable. <pre class="prolog"> assay( Counterfeit, Coins0, Step, Branch, Coins ) :- WeighingDatum = weighing_data(InfoContent, Left, Right, Table), step( Step, Left, Right, Table, Branches ), findall( WeighingDatum, valid_partition( Coins0, InfoContent, Left, Right, Table ), WeighingData ), sort( WeighingData, OrderedWeighingData ), member( WeighingDatum, OrderedWeighingData ), balance( Left, Right, Counterfeit, Result ), draw_inferences( Result, Left, Right, Table, Coins ), branch( Result, Branches, Branch ). </pre> ====balance( +Left, +Right, +Counterfeit, ?Result )==== holds when <var>Result</var> simulates the outcome of testing the coin collections <var>Left</var> and <var>Right</var> with a balance, where either may contain the <var>Counterfeit</var> coin. <pre class="prolog"> balance( Left, Right, Counterfeit, Result ):- counterfeit( Counterfeit, Coin, Weight ), ( contains_coin( Left, Coin ) -> balance_result( Weight, normal, Result ) ; contains_coin( Right, Coin ) -> balance_result( normal, Weight, Result ) ; otherwise -> Result = '=' ). balance_result( light, normal, < ). balance_result( heavy, normal, > ). balance_result( normal, heavy, < ). balance_result( normal, light, > ). </pre> ===Choosing which coins to weigh=== ====partition( +Coins, ?Left, ?Right, ?Table )==== holds when <var>Coins</var> is partitioned into three collections: <var>Left</var> side, <var>Right</var> side and <var>Table</var>. Operationally, alternative valid partitions are selected in order of reducing information content. <pre class="prolog"> partition( Coins, Left, Right, Table ) :- Partition = ptn(Info,Left,Right,Table), findall( Partition, valid_partition(Coins, Info, Left, Right, Table), Partitions ), sort( Partitions, OrderedPartitions ), member( Partition, OrderedPartitions ). </pre> ====valid_partition( +Coins, ?Content, ?Left, ?Right, ?Table )==== holds when <var>Coins</var> can be partitioned into three collections: <var>Left</var> side, <var>Right</var> side and <var>Table</var>; with the information content of the partition given by <var>Content</var>. The definition of a valid_partition ensures that: * <var>Left</var> and <var>Right</var> must have the same number of coins (at least one); * <var>Left</var> cannot contain any known_true coins, because adding true coins to both sides creates redundant comparisons; * Comparisons between mixtures of coins where only the choice of pans is different are equivalent, so a partial order (&ge;) on mixtures of coins is used to eliminate some redundant comparisons. <pre class="prolog"> valid_partition( Coins, Content, Left, Right, Table ):- part( known_true, Left, [] ), selection( Coins, Left, Coins1, LeftSum, LeftInfo ), selection( Coins1, Right, Table, RightSum, RightInfo ), LeftSum =:= RightSum, LeftSum @>= RightSum, table_information( Table, TableInfo ), sum( [LeftInfo,RightInfo,TableInfo], Content ). </pre> ====selection( +Coins, ?Sample, ?Residue, ?Sum, ?Content )==== holds when <var>Coins</var> is partitioned into two collections: <var>Sample</var> and <var>Residue</var>. <var>Sum</var> is used as both a fingerprint for the mixture of coins in <var>Sample</var> and a representation of the number of coins in <var>Sample</var>. <var>Content</var> estimates the information-content of <var>Sample</var>. <pre class="prolog"> selection( Coins, Sample, Residue, Sum, Content ) :- Sum = Count1+Count2+Count3+Count4, select_coins( not_heavy, Coins, Sample, Residue, Count1 ), select_coins( not_light, Coins, Sample, Residue, Count2 ), select_coins( untested, Coins, Sample, Residue, Count3 ), select_coins( known_true, Coins, Sample, Residue, Count4 ), Sum >= 1, Sum =< 6, information_content( [Count1,Count2,Count3,Count4], Content ). </pre> ====table_information( +Coins, ?Content )==== holds when <var>Coins</var> has 'information content' <var>Content</var>. <pre class="prolog"> table_information( Coins, Content ) :- count_coins( not_heavy, Coins, Count1 ), count_coins( not_light, Coins, Count2 ), count_coins( untested, Coins, Count3 ), count_coins( known_true, Coins, Count4 ), information_content( [Count1,Count2,Count3,Count4], Content ). count_coins( Part, Coins, Count ) :- part( Part, Coins, Selection ), length( Selection, Count ). </pre> === Updating what is known about the coins === ====draw_inferences( +Result, +Left, +Right, +Table, ?Coins )==== holds when <var>Result</var> is one of: * > (imbalance &ndash; left pan heavier), * < (imbalance &ndash; right pan heavier) or * <nowiki>=</nowiki> (pans balanced) from taking a weighing with the coin collections: <var>Left</var>, <var>Right</var> and <var>Table</var>. <var>Coins</var> is derived from this information using the following rules: * If the pans are unbalanced then only the previously untested or not_heavy coins on the lighter side of the balance are now not_heavy. Similarly, only the previously untested or not_light coins on the heavier side of the balance are now not_light. All the coins on the table are now known_true. * If the pans balance then all the coins weighed are known_true, with the coins on the <var>Table</var> left in their prior states. <pre class="prolog"> draw_inferences( <, Left, Right, Table, Coins ) :- imbalance_inferences( Left, Right, Table, Coins ). draw_inferences( >, Left, Right, Table, Coins ) :- imbalance_inferences( Right, Left, Table, Coins ). draw_inferences( =, Left, Right, Table, Coins ) :- becomes( [all(Left),known_true(Table),all(Right)], known_true( Coins ) ), becomes( untested(Table), untested(Coins) ), becomes( not_heavy(Table), not_heavy(Coins) ), becomes( not_light(Table), not_light(Coins) ). </pre> ====imbalance_inferences( +Lighter, +Heavier, +Table, ?Coins )==== holds when: * Only the untested or not_heavy coins in <var>Lighter</var> are not_heavy in <var>Coins</var>; * Only the untested or not_light coins in <var>Heavier</var> are not_light in <var>Coins</var>; * All the other coins in <var>Lighter</var> and <var>Heavier</var> and all the coins in <var>Table</var> are known_true in <var>Coins</var>; There are no untested coins in <var>Coins</var>. <pre class="prolog"> imbalance_inferences( Lighter, Heavier, Table, Coins ) :- becomes( [untested(Lighter),not_heavy(Lighter)], not_heavy(Coins) ), becomes( [untested(Heavier),not_light(Heavier)], not_light(Coins) ), becomes( [ known_true(Lighter), not_light(Lighter), known_true(Heavier), not_heavy(Heavier), all(Table) ], known_true(Coins) ), part( untested, Coins, [] ). </pre> ====becomes( +CollectionA, ?CollectionB )==== <var>CollectionA</var> becomes (part) <var>CollectionB</var> when <var>CollectionB</var> comprises the same coins as <var>CollectionA</var>. <pre class="prolog"> becomes( CollectionA, CollectionB ) :- unfolded( CollectionA, Coins ), unfolded( CollectionB, Coins ). </pre> ====unfolded( +Collection, ?Coins )==== holds when (part) <var>Collection</var> comprises <var>Coins</var>. <pre class="prolog"> unfolded( not_light(Collection), Coins ) :- part( not_light, Collection, Coins ). unfolded( not_heavy(Collection), Coins ) :- part( not_heavy, Collection, Coins ). unfolded( known_true(Collection), Coins ) :- part( known_true, Collection, Coins ). unfolded( untested(Collection), Coins ) :- part( untested, Collection, Coins ). unfolded( all(Collection), Coins ) :- collection_to_set( Collection, Coins ). unfolded( [Item|Items], Coins ) :- unfolded( Item, Value ), unfolded1( Items, Value, Coins ). unfolded1( [], Coins, Coins ). unfolded1( [Item|Items], Value, Coins ) :- unfolded( Item, Value0 ), ord_union( Value0, Value, Value1 ), unfolded1( Items, Value1, Coins ). </pre> ==Definite Clause Grammar== The following DCG presents the method for finding the counterfeit coin as a structured procedure. <pre class="prolog"> general_explanation( Procedure ) --> "Number the coins 1..12", newline, explanation( Procedure, 0 ). explanation( done(Coin, Weight), N ) --> tab( N ), "Conclude that the counterfeit coin is number ", literal( Coin ), ", which is ", literal( Weight ), newline. explanation( Step, N ) --> {step( Step, Left, Right, Table, Branches )}, tab( N ), "BEGIN", newline, tab( N ), "Put ", literal( Left ), " on the left-hand pan", newline, tab( N ), "Put ", literal( Right ), " on the right-hand pan", newline, tab( N ), "Leaving ", literal( Table ), " on the table", newline, branches_explained( Branches, N ), tab( N ), "END", newline. branches_explained( Branches, N ) --> next_step_explained( <, Branches, N ), next_step_explained( >, Branches, N ), next_step_explained( =, Branches, N ). next_step_explained( Result, Branch, N ) --> {branch( Result, Branch, Step )}, ( {var(Step)} -> "" | {nonvar(Step)} -> tab( N ), "If the ", literal( Result ), " then:", newline, explanation( Step, s(N) ) ). literal( 0 ) --> "0". literal( 1 ) --> "1". literal( 2 ) --> "2". literal( 3 ) --> "3". literal( 4 ) --> "4". literal( 5 ) --> "5". literal( 6 ) --> "6". literal( 7 ) --> "7". literal( 8 ) --> "8". literal( 9 ) --> "9". literal( 10 ) --> "10". literal( 11 ) --> "11". literal( 12 ) --> "12". literal( true ) --> "true". literal( heavy ) --> "heavy". literal( light ) --> "light". literal( = ) --> "pans balance". literal( < ) --> "right-hand pan is heavier". literal( > ) --> "left-hand pan is heavier". literal( Collection ) --> {collection_to_set( Collection , [H|T] )}, literal_set( T, H ). literal_set( [], Number ) --> "the coin numbered ", literal( Number ). literal_set( [H|T], Number ) --> "the coins numbered ", literal( Number ), literal_set1( T, H ). literal_set1( [], Number ) --> " and ", literal( Number ). literal_set1( [H|T], Number ) --> ", ", literal( Number ), literal_set1( T, H ). tab( 0 ) --> "". tab( s(N) ) --> " ", tab( N ). newline --> " ". </pre> ===Utility Predicates=== ====contains_coin( ?Collection, ?Coin )==== holds when <var>Coin</var> is a member of <var>Collection</var>. <pre class="prolog"> contains_coin( Collection, Coin ) :- part( _Part, Collection, Coins ), member( Coin, Coins ). </pre> ====collection_to_set( +Collection, ?Set )==== holds when <var>Set</var> is the distributed union of the <code>known_true</code>, <code>not_heavy</code>, <code>not_light</code> and <code>untested</code> ordsets comprising <var>Collection</var>. <pre class="prolog"> collection_to_set( Collection, Set ) :- part( known_true, Collection, KnownTrue ), part( not_heavy, Collection, NotHeavy ), part( not_light, Collection, NotLight ), part( untested, Collection, Untested ), ord_union( [KnownTrue,NotHeavy,NotLight,Untested], Set ). </pre> ===Information Content=== ==== information_content( +Counts, ?Content ) ==== holds when <var>Content</var> is the cumulative negative entropy of <var>Counts</var>. A reduction in entropy equates to a gain in information. <pre class="prolog"> information_content( Counts, Content ) :- information_content1( Counts, 0, Content ). information_content1( [], Content, Content ). information_content1( [Count|Counts], Content0, Content ):- coins_entropy( Count, Entropy ), Content1 is Content0-Entropy, information_content1( Counts, Content1, Content ). </pre> ==== coins_entropy( ?N, ?Entropy ) ==== holds when <var>Entropy</var> estimates the entropy of a sample of <var>N</var> coins. <var>Entropy</var> = P log₂(¹&frasl;_P), where P = <var>N</var>&divide;12. <pre class="prolog"> coins_entropy( 0, 0.0 ). coins_entropy( 1, 0.2987 ). coins_entropy( 2, 0.4308 ). coins_entropy( 3, 0.5 ). coins_entropy( 4, 0.5283 ). coins_entropy( 5, 0.5263 ). coins_entropy( 6, 0.5 ). coins_entropy( 7, 0.4536 ). coins_entropy( 8, 0.39 ). coins_entropy( 9, 0.3113 ). coins_entropy( 10, 0.2192 ). coins_entropy( 11, 0.1151 ). coins_entropy( 12, 0.0 ). </pre> ====select_coins( +Part, +Coins, ?Sample, ?Residue, ?N )==== holds when <var>N</var> coins from <var>Part</var> of <var>Coins</var> form <var>Part</var> of <var>Sample</var>, with the remainder forming <var>Part</var> of <var>Residue</var>. <pre class="prolog"> select_coins( Part, Coins, Sample, Residue, Count ) :- part( Part, Coins, Input ), part( Part, Sample, Selection ), part( Part, Residue, Remainder ), select_n( Count, Input, Selection, Remainder ). select_n( 0, In, [], In ). select_n( 1, [A|Suffix], [A], Suffix ). select_n( 2, [A,B|Suffix], [A,B], Suffix ). select_n( 3, [A,B,C|Suffix], [A,B,C], Suffix ). select_n( 4, [A,B,C,D|Suffix], [A,B,C,D], Suffix ). select_n( 5, [A,B,C,D,E|Suffix], [A,B,C,D,E], Suffix ). select_n( 6, [A,B,C,D,E,F|Suffix], [A,B,C,D,E,F], Suffix ). </pre> Load a small library of [[Puzzle Utilities]]. <pre class="prolog"> :- ensure_loaded( misc ). </pre> Use the ordsets library. <pre class="prolog"> :- use_module( library(ordsets), [ord_union/2,ord_union/3] ). </pre> The code is available as plain text [https://binding-time.co.uk/download/counterfeit.txt here]. ==Output== <div class="result"> Number the coins 1..12 BEGIN Put the coins numbered 1, 2, 3 and 4 on the left-hand pan Put the coins numbered 5, 6, 7 and 8 on the right-hand pan Leaving the coins numbered 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 1, 2, 5 and 6 on the left-hand pan Put the coins numbered 3, 7, 9 and 10 on the right-hand pan Leaving the coins numbered 4, 8, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 1 and 7 on the left-hand pan Put the coins numbered 3 and 4 on the right-hand pan Leaving the coins numbered 2, 5, 6, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 1, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 7, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 2, which is light END If the left-hand pan is heavier then: BEGIN Put the coins numbered 3 and 5 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 4, 6, 7, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 3, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 5, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 6, which is heavy END If the pans balance then: BEGIN Put the coins numbered 4 and 8 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 3, 5, 6, 7, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 4, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 8, which is heavy END END If the left-hand pan is heavier then: BEGIN Put the coins numbered 1, 2, 5 and 6 on the left-hand pan Put the coins numbered 3, 7, 9 and 10 on the right-hand pan Leaving the coins numbered 4, 8, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 3 and 5 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 4, 6, 7, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 5, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 3, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 6, which is light END If the left-hand pan is heavier then: BEGIN Put the coins numbered 1 and 7 on the left-hand pan Put the coins numbered 3 and 4 on the right-hand pan Leaving the coins numbered 2, 5, 6, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 7, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 1, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 2, which is heavy END If the pans balance then: BEGIN Put the coins numbered 4 and 8 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 3, 5, 6, 7, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 8, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 4, which is heavy END END If the pans balance then: BEGIN Put the coins numbered 9, 10 and 11 on the left-hand pan Put the coins numbered 1, 2 and 3 on the right-hand pan Leaving the coins numbered 4, 5, 6, 7, 8 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coin numbered 9 on the left-hand pan Put the coin numbered 10 on the right-hand pan Leaving the coins numbered 1, 2, 3, 4, 5, 6, 7, 8, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 9, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 10, which is light If the pans balance then: Conclude that the counterfeit coin is number 11, which is light END If the left-hand pan is heavier then: BEGIN Put the coin numbered 9 on the left-hand pan Put the coin numbered 10 on the right-hand pan Leaving the coins numbered 1, 2, 3, 4, 5, 6, 7, 8, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 10, which is heavy If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 9, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 11, which is heavy END If the pans balance then: BEGIN Put the coin numbered 12 on the left-hand pan Put the coin numbered 1 on the right-hand pan Leaving the coins numbered 2, 3, 4, 5, 6, 7, 8, 9, 10 and 11 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 12, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 12, which is heavy END END END </div> ---- 9d802c45c03f68a237e0b136ebc87abe9f12039e 200 199 2017-11-23T22:52:54Z John 2 partition/4 used to aid readability. wikitext text/x-wiki __NOTOC__ ==Problem Definition== We are given 12 apparently identical coins - one of which is counterfeit. We know that the counterfeit has a different weight from the others, but we don't know if it's heavier or lighter. ===Task:=== Devise a procedure to identify any counterfeit coin using a balance to take up to three comparative weighings. ==Strategy== The information from three suitable weighings will make all but one of the coins, which are untested initially, known_true. There are three alternative deductions that make a coin known_true: * if it is not_heavy and not_light &ndash; having been on both the comparatively lighter and heavier sides of imbalances; * if it was excluded from an imbalance; * if it was included in a balanced weighing. After three weighings there must be exactly one coin, the counterfeit, which is not known_true. If the counterfeit is not known_true and not_heavy we deduce that it must be light. If it is not known_true and not_light, it must be heavy. We use a generate-and-test method as follows: * Create the set of all possible counterfeits: 12 coins &times; 2 weights ; * Devise a procedure that can identify the first counterfeit coin; * Show that the same procedure works for every other counterfeit coin. ==Entry Point== ====go==== is the entry point. It solves the puzzle, then uses a DCG to pretty-print the resulting procedure. <pre class="prolog"> go :- coins_puzzle( Procedure ), phrase( general_explanation( Procedure ), Chars ), put_chars( Chars ). </pre> ====coins_puzzle( ?Procedure )==== generates the set of all possible counterfeit coins and finds, or proves, that <var>Procedure</var> can identify them all. <pre class="prolog"> coins_puzzle( Procedure ) :- coins( Coins ), counterfeit( Counterfeit, Coin, Weight ), findall( Counterfeit, (member(Coin,Coins), counterfeit_weight(Weight)), Counterfeits ), coins_puzzle_solution( Counterfeits, Procedure ). coins_puzzle_solution( [], _Procedure ). coins_puzzle_solution( [Counterfeit|Counterfeits], Procedure ) :- solve_coins( Counterfeit, Procedure ), coins_puzzle_solution( Counterfeits, Procedure ). </pre> A procedure is either ''done'', identifying a particular coin and whether it is heavy or light, or it is a ''step''. A ''step'' defines the coins to be placed on the <var>Left</var> and <var>Right</var> pans, with the residue remaining on the <var>Table</var>, and three <var>Branches</var>, one of which will be chosen depending on the outcome of the weighing. <pre class="prolog"> step( step(Left,Right,Table,Branches), Left, Right, Table, Branches). </pre> The <var>Branches</var> are three procedures equating to: * > (left pan heavier), * < (right pan heavier) and * <nowiki>= (pans balance).</nowiki> <pre class="prolog"> branch( >, branches(_Equal, GT, _LT), GT ). branch( <, branches(_Equal, _GT, LT), LT ). branch( =, branches(Equal, _GT, _LT), Equal ). </pre> The counterfeit is defined by its number and whether it is heavy or light. <pre class="prolog"> counterfeit( counterfeit(Coin, HeavyOrLight), Coin, HeavyOrLight ). coins( [1,2,3,4,5,6,7,8,9,10,11,12] ). counterfeit_weight( heavy ). counterfeit_weight( light ). </pre> A ''coin collection'' comprises four <code>part</code>s (subsets): the <code>known_true</code>, <code>not_heavy</code>, <code>not_light</code> and <code>untested</code> sets of coins. <pre class="prolog"> part( known_true, collection(Coins,_,_,_), Coins ). part( not_heavy, collection(_,Coins,_,_), Coins ). part( not_light, collection(_,_,Coins,_), Coins ). part( untested, collection(_,_,_,Coins), Coins ). </pre> ==Solution== ====solve_coins( +Counterfeit, ?Procedure )==== holds when <var>Procedure</var> can correctly identify the <var>Counterfeit</var> coin. Beginning with a ''start'' collection, in which all the coins are untested, the <var>Procedure</var> comprises three steps. For each step, a weighing is made and a ''branch'' is made in the <var>Procedure</var>, depending on the result of the weighing. After three steps, the <var>Procedure</var> must have reached the ''end'' condition. Finally, an assertion (redundant test) ensures that the <var>Procedure</var> has found the correct ''end'' condition. <pre class="prolog"> solve_coins( Counterfeit, Procedure ) :- start( Coins0 ), assay( Counterfeit, Coins0, Procedure, Branch1, Coins1 ), assay( Counterfeit, Coins1, Branch1, Branch2, Coins2 ), assay( Counterfeit, Coins2, Branch2, done(Coin, HeavyOrLight), Coins3 ), end( Coins3, Coin, HeavyOrLight ), counterfeit( Counterfeit, Coin, HeavyOrLight ). start( Coins ) :- coins( Untested ), part( untested, Coins, Untested ), part( not_heavy, Coins, [] ), part( not_light, Coins, [] ), part( known_true, Coins, [] ). end( Coins, Coin, HeavyOrLight ) :- part( untested, Coins, [] ), part( not_heavy, Coins, Light ), part( not_light, Coins, Heavy ), end_result( Heavy, Light, Coin, HeavyOrLight ). end_result( [Coin], [], Coin, heavy ). end_result( [], [Coin], Coin, light ). </pre> === Simulating the weighing process === ====assay( +Counterfeit, +Coins0, ?Step, ?Branch, ?Coins1 )==== holds when the appropriate <var>Branch</var> from <var>Step</var> is chosen by comparing the weights of two coin collections taken from the full set of coins: <var>Coins0</var>. <var>Coins1</var> is the full set of coins updated with the inferences drawn from the weighing, where <var>Counterfeit</var> is used to determine the result of the weighing. This predicate applies the critical insight into the solution of this puzzle: we have 24 (12 &times; 2) possible inputs to the procedure, with only 27 (3 &times; 3 &times; 3) possible outcomes from the weighings. Therefore, it is clear that each weighing must have a very high [[#Information Content|information content]]. Choosing which weighing to make by estimating the available information content makes the problem tractable. <pre class="prolog"> assay( Counterfeit, Coins0, Step, Branch, Coins ) :- step( Step, Left, Right, Table, Branches ), partition( Coins0, Left, Right, Table ), balance( Left, Right, Counterfeit, Result ), draw_inferences( Result, Left, Right, Table, Coins ), branch( Result, Branches, Branch ). </pre> ====balance( +Left, +Right, +Counterfeit, ?Result )==== holds when <var>Result</var> simulates the outcome of testing the coin collections <var>Left</var> and <var>Right</var> with a balance, where either may contain the <var>Counterfeit</var> coin. <pre class="prolog"> balance( Left, Right, Counterfeit, Result ):- counterfeit( Counterfeit, Coin, Weight ), ( contains_coin( Left, Coin ) -> balance_result( Weight, normal, Result ) ; contains_coin( Right, Coin ) -> balance_result( normal, Weight, Result ) ; otherwise -> Result = '=' ). balance_result( light, normal, < ). balance_result( heavy, normal, > ). balance_result( normal, heavy, < ). balance_result( normal, light, > ). </pre> ===Choosing which coins to weigh=== ====partition( +Coins, ?Left, ?Right, ?Table )==== holds when <var>Coins</var> is partitioned into three collections: <var>Left</var> side, <var>Right</var> side and <var>Table</var>. Operationally, alternative valid partitions are selected in order of reducing information content. <pre class="prolog"> partition( Coins, Left, Right, Table ) :- Partition = ptn(Info,Left,Right,Table), findall( Partition, valid_partition(Coins, Info, Left, Right, Table), Partitions ), sort( Partitions, OrderedPartitions ), member( Partition, OrderedPartitions ). </pre> ====valid_partition( +Coins, ?Content, ?Left, ?Right, ?Table )==== holds when <var>Coins</var> can be partitioned into three collections: <var>Left</var> side, <var>Right</var> side and <var>Table</var>; with the information content of the partition given by <var>Content</var>. The definition of a valid_partition ensures that: * <var>Left</var> and <var>Right</var> must have the same number of coins (at least one); * <var>Left</var> cannot contain any known_true coins, because adding true coins to both sides creates redundant comparisons; * Comparisons between mixtures of coins where only the choice of pans is different are equivalent, so a partial order (&ge;) on mixtures of coins is used to eliminate some redundant comparisons. <pre class="prolog"> valid_partition( Coins, Content, Left, Right, Table ):- part( known_true, Left, [] ), selection( Coins, Left, Coins1, LeftSum, LeftInfo ), selection( Coins1, Right, Table, RightSum, RightInfo ), LeftSum =:= RightSum, LeftSum @>= RightSum, table_information( Table, TableInfo ), sum( [LeftInfo,RightInfo,TableInfo], Content ). </pre> ====selection( +Coins, ?Sample, ?Residue, ?Sum, ?Content )==== holds when <var>Coins</var> is partitioned into two collections: <var>Sample</var> and <var>Residue</var>. <var>Sum</var> is used as both a fingerprint for the mixture of coins in <var>Sample</var> and a representation of the number of coins in <var>Sample</var>. <var>Content</var> estimates the information-content of <var>Sample</var>. <pre class="prolog"> selection( Coins, Sample, Residue, Sum, Content ) :- Sum = Count1+Count2+Count3+Count4, select_coins( not_heavy, Coins, Sample, Residue, Count1 ), select_coins( not_light, Coins, Sample, Residue, Count2 ), select_coins( untested, Coins, Sample, Residue, Count3 ), select_coins( known_true, Coins, Sample, Residue, Count4 ), Sum >= 1, Sum =< 6, information_content( [Count1,Count2,Count3,Count4], Content ). </pre> ====table_information( +Coins, ?Content )==== holds when <var>Coins</var> has 'information content' <var>Content</var>. <pre class="prolog"> table_information( Coins, Content ) :- count_coins( not_heavy, Coins, Count1 ), count_coins( not_light, Coins, Count2 ), count_coins( untested, Coins, Count3 ), count_coins( known_true, Coins, Count4 ), information_content( [Count1,Count2,Count3,Count4], Content ). count_coins( Part, Coins, Count ) :- part( Part, Coins, Selection ), length( Selection, Count ). </pre> === Updating what is known about the coins === ====draw_inferences( +Result, +Left, +Right, +Table, ?Coins )==== holds when <var>Result</var> is one of: * > (imbalance &ndash; left pan heavier), * < (imbalance &ndash; right pan heavier) or * <nowiki>=</nowiki> (pans balanced) from taking a weighing with the coin collections: <var>Left</var>, <var>Right</var> and <var>Table</var>. <var>Coins</var> is derived from this information using the following rules: * If the pans are unbalanced then only the previously untested or not_heavy coins on the lighter side of the balance are now not_heavy. Similarly, only the previously untested or not_light coins on the heavier side of the balance are now not_light. All the coins on the table are now known_true. * If the pans balance then all the coins weighed are known_true, with the coins on the <var>Table</var> left in their prior states. <pre class="prolog"> draw_inferences( <, Left, Right, Table, Coins ) :- imbalance_inferences( Left, Right, Table, Coins ). draw_inferences( >, Left, Right, Table, Coins ) :- imbalance_inferences( Right, Left, Table, Coins ). draw_inferences( =, Left, Right, Table, Coins ) :- becomes( [all(Left),known_true(Table),all(Right)], known_true( Coins ) ), becomes( untested(Table), untested(Coins) ), becomes( not_heavy(Table), not_heavy(Coins) ), becomes( not_light(Table), not_light(Coins) ). </pre> ====imbalance_inferences( +Lighter, +Heavier, +Table, ?Coins )==== holds when: * Only the untested or not_heavy coins in <var>Lighter</var> are not_heavy in <var>Coins</var>; * Only the untested or not_light coins in <var>Heavier</var> are not_light in <var>Coins</var>; * All the other coins in <var>Lighter</var> and <var>Heavier</var> and all the coins in <var>Table</var> are known_true in <var>Coins</var>; There are no untested coins in <var>Coins</var>. <pre class="prolog"> imbalance_inferences( Lighter, Heavier, Table, Coins ) :- becomes( [untested(Lighter),not_heavy(Lighter)], not_heavy(Coins) ), becomes( [untested(Heavier),not_light(Heavier)], not_light(Coins) ), becomes( [ known_true(Lighter), not_light(Lighter), known_true(Heavier), not_heavy(Heavier), all(Table) ], known_true(Coins) ), part( untested, Coins, [] ). </pre> ====becomes( +CollectionA, ?CollectionB )==== <var>CollectionA</var> becomes (part) <var>CollectionB</var> when <var>CollectionB</var> comprises the same coins as <var>CollectionA</var>. <pre class="prolog"> becomes( CollectionA, CollectionB ) :- unfolded( CollectionA, Coins ), unfolded( CollectionB, Coins ). </pre> ====unfolded( +Collection, ?Coins )==== holds when (part) <var>Collection</var> comprises <var>Coins</var>. <pre class="prolog"> unfolded( not_light(Collection), Coins ) :- part( not_light, Collection, Coins ). unfolded( not_heavy(Collection), Coins ) :- part( not_heavy, Collection, Coins ). unfolded( known_true(Collection), Coins ) :- part( known_true, Collection, Coins ). unfolded( untested(Collection), Coins ) :- part( untested, Collection, Coins ). unfolded( all(Collection), Coins ) :- collection_to_set( Collection, Coins ). unfolded( [Item|Items], Coins ) :- unfolded( Item, Value ), unfolded1( Items, Value, Coins ). unfolded1( [], Coins, Coins ). unfolded1( [Item|Items], Value, Coins ) :- unfolded( Item, Value0 ), ord_union( Value0, Value, Value1 ), unfolded1( Items, Value1, Coins ). </pre> ==Definite Clause Grammar== The following DCG presents the method for finding the counterfeit coin as a structured procedure. <pre class="prolog"> general_explanation( Procedure ) --> "Number the coins 1..12", newline, explanation( Procedure, 0 ). explanation( done(Coin, Weight), N ) --> tab( N ), "Conclude that the counterfeit coin is number ", literal( Coin ), ", which is ", literal( Weight ), newline. explanation( Step, N ) --> {step( Step, Left, Right, Table, Branches )}, tab( N ), "BEGIN", newline, tab( N ), "Put ", literal( Left ), " on the left-hand pan", newline, tab( N ), "Put ", literal( Right ), " on the right-hand pan", newline, tab( N ), "Leaving ", literal( Table ), " on the table", newline, branches_explained( Branches, N ), tab( N ), "END", newline. branches_explained( Branches, N ) --> next_step_explained( <, Branches, N ), next_step_explained( >, Branches, N ), next_step_explained( =, Branches, N ). next_step_explained( Result, Branch, N ) --> {branch( Result, Branch, Step )}, ( {var(Step)} -> "" | {nonvar(Step)} -> tab( N ), "If the ", literal( Result ), " then:", newline, explanation( Step, s(N) ) ). literal( 0 ) --> "0". literal( 1 ) --> "1". literal( 2 ) --> "2". literal( 3 ) --> "3". literal( 4 ) --> "4". literal( 5 ) --> "5". literal( 6 ) --> "6". literal( 7 ) --> "7". literal( 8 ) --> "8". literal( 9 ) --> "9". literal( 10 ) --> "10". literal( 11 ) --> "11". literal( 12 ) --> "12". literal( true ) --> "true". literal( heavy ) --> "heavy". literal( light ) --> "light". literal( = ) --> "pans balance". literal( < ) --> "right-hand pan is heavier". literal( > ) --> "left-hand pan is heavier". literal( Collection ) --> {collection_to_set( Collection , [H|T] )}, literal_set( T, H ). literal_set( [], Number ) --> "the coin numbered ", literal( Number ). literal_set( [H|T], Number ) --> "the coins numbered ", literal( Number ), literal_set1( T, H ). literal_set1( [], Number ) --> " and ", literal( Number ). literal_set1( [H|T], Number ) --> ", ", literal( Number ), literal_set1( T, H ). tab( 0 ) --> "". tab( s(N) ) --> " ", tab( N ). newline --> " ". </pre> ===Utility Predicates=== ====contains_coin( ?Collection, ?Coin )==== holds when <var>Coin</var> is a member of <var>Collection</var>. <pre class="prolog"> contains_coin( Collection, Coin ) :- part( _Part, Collection, Coins ), member( Coin, Coins ). </pre> ====collection_to_set( +Collection, ?Set )==== holds when <var>Set</var> is the distributed union of the <code>known_true</code>, <code>not_heavy</code>, <code>not_light</code> and <code>untested</code> ordsets comprising <var>Collection</var>. <pre class="prolog"> collection_to_set( Collection, Set ) :- part( known_true, Collection, KnownTrue ), part( not_heavy, Collection, NotHeavy ), part( not_light, Collection, NotLight ), part( untested, Collection, Untested ), ord_union( [KnownTrue,NotHeavy,NotLight,Untested], Set ). </pre> ===Information Content=== ==== information_content( +Counts, ?Content ) ==== holds when <var>Content</var> is the cumulative negative entropy of <var>Counts</var>. A reduction in entropy equates to a gain in information. <pre class="prolog"> information_content( Counts, Content ) :- information_content1( Counts, 0, Content ). information_content1( [], Content, Content ). information_content1( [Count|Counts], Content0, Content ):- coins_entropy( Count, Entropy ), Content1 is Content0-Entropy, information_content1( Counts, Content1, Content ). </pre> ==== coins_entropy( ?N, ?Entropy ) ==== holds when <var>Entropy</var> estimates the entropy of a sample of <var>N</var> coins. <var>Entropy</var> = P log₂(¹&frasl;_P), where P = <var>N</var>&divide;12. <pre class="prolog"> coins_entropy( 0, 0.0 ). coins_entropy( 1, 0.2987 ). coins_entropy( 2, 0.4308 ). coins_entropy( 3, 0.5 ). coins_entropy( 4, 0.5283 ). coins_entropy( 5, 0.5263 ). coins_entropy( 6, 0.5 ). coins_entropy( 7, 0.4536 ). coins_entropy( 8, 0.39 ). coins_entropy( 9, 0.3113 ). coins_entropy( 10, 0.2192 ). coins_entropy( 11, 0.1151 ). coins_entropy( 12, 0.0 ). </pre> ====select_coins( +Part, +Coins, ?Sample, ?Residue, ?N )==== holds when <var>N</var> coins from <var>Part</var> of <var>Coins</var> form <var>Part</var> of <var>Sample</var>, with the remainder forming <var>Part</var> of <var>Residue</var>. <pre class="prolog"> select_coins( Part, Coins, Sample, Residue, Count ) :- part( Part, Coins, Input ), part( Part, Sample, Selection ), part( Part, Residue, Remainder ), select_n( Count, Input, Selection, Remainder ). select_n( 0, In, [], In ). select_n( 1, [A|Suffix], [A], Suffix ). select_n( 2, [A,B|Suffix], [A,B], Suffix ). select_n( 3, [A,B,C|Suffix], [A,B,C], Suffix ). select_n( 4, [A,B,C,D|Suffix], [A,B,C,D], Suffix ). select_n( 5, [A,B,C,D,E|Suffix], [A,B,C,D,E], Suffix ). select_n( 6, [A,B,C,D,E,F|Suffix], [A,B,C,D,E,F], Suffix ). </pre> Load a small library of [[Puzzle Utilities]]. <pre class="prolog"> :- ensure_loaded( misc ). </pre> Use the ordsets library. <pre class="prolog"> :- use_module( library(ordsets), [ord_union/2,ord_union/3] ). </pre> The code is available as plain text [https://binding-time.co.uk/download/counterfeit.txt here]. ==Output== <div class="result"> Number the coins 1..12 BEGIN Put the coins numbered 1, 2, 3 and 4 on the left-hand pan Put the coins numbered 5, 6, 7 and 8 on the right-hand pan Leaving the coins numbered 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 1, 2, 5 and 6 on the left-hand pan Put the coins numbered 3, 7, 9 and 10 on the right-hand pan Leaving the coins numbered 4, 8, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 1 and 7 on the left-hand pan Put the coins numbered 3 and 4 on the right-hand pan Leaving the coins numbered 2, 5, 6, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 1, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 7, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 2, which is light END If the left-hand pan is heavier then: BEGIN Put the coins numbered 3 and 5 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 4, 6, 7, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 3, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 5, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 6, which is heavy END If the pans balance then: BEGIN Put the coins numbered 4 and 8 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 3, 5, 6, 7, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 4, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 8, which is heavy END END If the left-hand pan is heavier then: BEGIN Put the coins numbered 1, 2, 5 and 6 on the left-hand pan Put the coins numbered 3, 7, 9 and 10 on the right-hand pan Leaving the coins numbered 4, 8, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 3 and 5 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 4, 6, 7, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 5, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 3, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 6, which is light END If the left-hand pan is heavier then: BEGIN Put the coins numbered 1 and 7 on the left-hand pan Put the coins numbered 3 and 4 on the right-hand pan Leaving the coins numbered 2, 5, 6, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 7, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 1, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 2, which is heavy END If the pans balance then: BEGIN Put the coins numbered 4 and 8 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 3, 5, 6, 7, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 8, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 4, which is heavy END END If the pans balance then: BEGIN Put the coins numbered 9, 10 and 11 on the left-hand pan Put the coins numbered 1, 2 and 3 on the right-hand pan Leaving the coins numbered 4, 5, 6, 7, 8 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coin numbered 9 on the left-hand pan Put the coin numbered 10 on the right-hand pan Leaving the coins numbered 1, 2, 3, 4, 5, 6, 7, 8, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 9, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 10, which is light If the pans balance then: Conclude that the counterfeit coin is number 11, which is light END If the left-hand pan is heavier then: BEGIN Put the coin numbered 9 on the left-hand pan Put the coin numbered 10 on the right-hand pan Leaving the coins numbered 1, 2, 3, 4, 5, 6, 7, 8, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 10, which is heavy If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 9, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 11, which is heavy END If the pans balance then: BEGIN Put the coin numbered 12 on the left-hand pan Put the coin numbered 1 on the right-hand pan Leaving the coins numbered 2, 3, 4, 5, 6, 7, 8, 9, 10 and 11 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 12, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 12, which is heavy END END END </div> ---- c94767e4a0d39078d80823fedac7b15330d27214 0 13 173 126 2017-01-05T22:46:37Z John 2 Remove broken syntax highlighting wikitext text/x-wiki __NOTOC__ Although this problem has a straightforward solution, it does demonstrate the value of thinking declaratively in understanding the problem, which relates to &ldquo;don't know&rdquo; nondeterminism, and an appropriate use of lemmas. == Problem: == [https://groups.google.com/forum/#!msg/de.comp.lang.java/xQ6T3kZGqcE/-OTNgyB8yxIJ Problem as posted to comp.lang.prolog] by Thorsten Seelend. Also known as Hans Freudenthal's [[wikipedia:Impossible Puzzle|Impossible Puzzle]]. <blockquote>Mister X thinks about two integers between 1 and 100 excluding: </blockquote> =====MISTERX: Two integers, X and Y between 2 and 99 (My formalization of the given information)===== <pre class="prolog">two_integers( X, Y ) :- between( 2, 98, X ), between( X, 99, Y ).</pre> He tells Susan the Sum of them and Peter their Product. Their task is to get the two original values without telling each other the numbers that Mister X told them. <blockquote>After some time Peter says: &ldquo;I can't say definitively which are the original numbers.&rdquo;</blockquote> =====PETER1: There is more than one pair of factors giving Product===== <pre class="prolog">property( peter1, Product ) :- \+ unique_factors( Product ).</pre> <blockquote>Then Susan responds: &ldquo;Neither can I, but I knew that you couldn't know it.&rdquo;</blockquote> =====SUSAN1: The product of ''every'' pair of summands giving Sum has the property PETER1===== <pre class="prolog">property( susan1, Sum ) :- forall( ordered_summands(Sum, X, Y), peter1(X * Y) ).</pre> <blockquote>Peter: &ldquo;Really? So now I know the original numbers&rdquo;.</blockquote> =====PETER2: ''exactly one'' pair of factors giving Product gives a sum with the property SUSAN1===== <pre class="prolog">property( peter2, Product ) :- unique_solution( (ordered_factors(Product, X, Y), susan1(X+Y)) ).</pre> <blockquote>Susan: &ldquo;Now I know them too&rdquo;.</blockquote> =====SUSAN2: ''exactly one'' pair of summands giving Sum has a product with the property PETER2===== <pre class="prolog">property( susan2, Sum ) :- unique_solution( (ordered_summands(Sum, X, Y), peter2(X * Y)) ).</pre> <blockquote>Question: What are the two numbers that Mister X thought of?</blockquote> =====Unique solution===== <pre class="prolog">solve( X, Y ) :- unique_solution( mister_x(X, Y) ). mister_x( X, Y ) :- two_integers( X, Y ), Sum is X + Y, Product is X * Y, peter1( Product ), susan1( Sum ), peter2( Product ), susan2( Sum ).</pre> == Macros == <pre class="prolog">peter1( Product ) :- lemma( peter1, Product ). peter2( Product ) :- lemma( peter2, Product ). susan1( Sum ) :- lemma( susan1, Sum ). susan2( Sum ) :- lemma( susan2, Sum ).</pre> == Lemmas == ====lemma( +Property, +Expression )==== holds wherever <var>Property</var> holds for <var>Expression</var>. Asserted facts are used to record successful (''positive'') or failed (''negative'') demonstrations. This saves recomputation without changing the meaning of the pure program. Although the use of side-effects is generally undesirable, the use of lemmas is justified when the alternative is to compromise performance or clarity. Using lemmas or tabling to cache results is an order of magnitude faster than recalculating each property every time it is used. <pre class="prolog">:- dynamic positive/2, negative/2. lemma( Name, Expression ) :- Value is Expression, ( positive( Value, Name ) -> true ; \+ negative( Value, Name ) -> ( property(Name, Value) -> assert( positive(Value, Name) ) ; otherwise -> assert( negative(Value, Name) ), fail ) ).</pre> == Supporting Predicates == ====ordered_summands( +Sum, ?X, ?Y )==== when <var>X</var> &le; <var>Y</var> and Sum = <var>X</var>+<var>Y</var>. NB: Since <var>X</var>&le;<var>Y</var> it follows that <var>X</var> &le; <var>Sum</var>/2. <pre class="prolog">ordered_summands( Z, X, Y ) :- Half is Z//2, between( 2, Half, X ), Y is Z - X, between( X, 98, Y ).</pre> ====ordered_factors( +Product, ?X, ?Y )==== when <var>X</var> &le; <var>Y</var> and <var>Product</var> = <var>X</var> &times; <var>Y</var>. NB: Since <var>X</var>&le;<var>Y</var> it follows that <var>X</var> &le; &radic;<var>Product</var>. <pre class="prolog">ordered_factors( Z, X, Y ) :- integer_sqrt( Z, SqrtZ ), between( 2, SqrtZ, X ), Y is Z // X, between( X, 99, Y ), Z =:= X * Y.</pre> ====unique_factors( +Product )==== when <var>Product</var> has exactly one pair of factors. <pre class="prolog">unique_factors( Product ) :- ordered_factors( Product, X, _Y ), \+ (ordered_factors(Product, X1, _Y1), X1 =\= X).</pre> ====integer_sqrt( +N, ?Sqrt )==== when <var>Sqrt</var>² &le; <var>N</var> and (<var>Sqrt</var>+1)² &ge; <var>N</var>. <pre class="prolog">integer_sqrt( N, Sqrt ) :- Float is N * 1.0, sqrt( Float, FSqrt ), Sqrt is integer(FSqrt).</pre> Load a small library of [[Puzzle Utilities]]. <pre class="prolog"> :- ensure_loaded( misc ). </pre> The code is available as plain text [https://binding-time.co.uk/download/mister_x.txt here]. == Result == This program finds X and Y as '''4''' and '''13'''. == Tabling == Using tabling, rather than explicit lemmas, can simplify code. [https://binding-time.co.uk/download/xsb_mister_x.txt A version adapted for XSB Prolog is available here.] 57c4cf98d2e5793e67ecffa2b7b0c02414275ab5 174 173 2017-01-05T22:49:57Z John 2 /* integer_sqrt( +N, ?Sqrt ) */ wikitext text/x-wiki __NOTOC__ Although this problem has a straightforward solution, it does demonstrate the value of thinking declaratively in understanding the problem, which relates to &ldquo;don't know&rdquo; nondeterminism, and an appropriate use of lemmas. == Problem: == [https://groups.google.com/forum/#!msg/de.comp.lang.java/xQ6T3kZGqcE/-OTNgyB8yxIJ Problem as posted to comp.lang.prolog] by Thorsten Seelend. Also known as Hans Freudenthal's [[wikipedia:Impossible Puzzle|Impossible Puzzle]]. <blockquote>Mister X thinks about two integers between 1 and 100 excluding: </blockquote> =====MISTERX: Two integers, X and Y between 2 and 99 (My formalization of the given information)===== <pre class="prolog">two_integers( X, Y ) :- between( 2, 98, X ), between( X, 99, Y ).</pre> He tells Susan the Sum of them and Peter their Product. Their task is to get the two original values without telling each other the numbers that Mister X told them. <blockquote>After some time Peter says: &ldquo;I can't say definitively which are the original numbers.&rdquo;</blockquote> =====PETER1: There is more than one pair of factors giving Product===== <pre class="prolog">property( peter1, Product ) :- \+ unique_factors( Product ).</pre> <blockquote>Then Susan responds: &ldquo;Neither can I, but I knew that you couldn't know it.&rdquo;</blockquote> =====SUSAN1: The product of ''every'' pair of summands giving Sum has the property PETER1===== <pre class="prolog">property( susan1, Sum ) :- forall( ordered_summands(Sum, X, Y), peter1(X * Y) ).</pre> <blockquote>Peter: &ldquo;Really? So now I know the original numbers&rdquo;.</blockquote> =====PETER2: ''exactly one'' pair of factors giving Product gives a sum with the property SUSAN1===== <pre class="prolog">property( peter2, Product ) :- unique_solution( (ordered_factors(Product, X, Y), susan1(X+Y)) ).</pre> <blockquote>Susan: &ldquo;Now I know them too&rdquo;.</blockquote> =====SUSAN2: ''exactly one'' pair of summands giving Sum has a product with the property PETER2===== <pre class="prolog">property( susan2, Sum ) :- unique_solution( (ordered_summands(Sum, X, Y), peter2(X * Y)) ).</pre> <blockquote>Question: What are the two numbers that Mister X thought of?</blockquote> =====Unique solution===== <pre class="prolog">solve( X, Y ) :- unique_solution( mister_x(X, Y) ). mister_x( X, Y ) :- two_integers( X, Y ), Sum is X + Y, Product is X * Y, peter1( Product ), susan1( Sum ), peter2( Product ), susan2( Sum ).</pre> == Macros == <pre class="prolog">peter1( Product ) :- lemma( peter1, Product ). peter2( Product ) :- lemma( peter2, Product ). susan1( Sum ) :- lemma( susan1, Sum ). susan2( Sum ) :- lemma( susan2, Sum ).</pre> == Lemmas == ====lemma( +Property, +Expression )==== holds wherever <var>Property</var> holds for <var>Expression</var>. Asserted facts are used to record successful (''positive'') or failed (''negative'') demonstrations. This saves recomputation without changing the meaning of the pure program. Although the use of side-effects is generally undesirable, the use of lemmas is justified when the alternative is to compromise performance or clarity. Using lemmas or tabling to cache results is an order of magnitude faster than recalculating each property every time it is used. <pre class="prolog">:- dynamic positive/2, negative/2. lemma( Name, Expression ) :- Value is Expression, ( positive( Value, Name ) -> true ; \+ negative( Value, Name ) -> ( property(Name, Value) -> assert( positive(Value, Name) ) ; otherwise -> assert( negative(Value, Name) ), fail ) ).</pre> == Supporting Predicates == ====ordered_summands( +Sum, ?X, ?Y )==== when <var>X</var> &le; <var>Y</var> and Sum = <var>X</var>+<var>Y</var>. NB: Since <var>X</var>&le;<var>Y</var> it follows that <var>X</var> &le; <var>Sum</var>/2. <pre class="prolog">ordered_summands( Z, X, Y ) :- Half is Z//2, between( 2, Half, X ), Y is Z - X, between( X, 98, Y ).</pre> ====ordered_factors( +Product, ?X, ?Y )==== when <var>X</var> &le; <var>Y</var> and <var>Product</var> = <var>X</var> &times; <var>Y</var>. NB: Since <var>X</var>&le;<var>Y</var> it follows that <var>X</var> &le; &radic;<var>Product</var>. <pre class="prolog">ordered_factors( Z, X, Y ) :- integer_sqrt( Z, SqrtZ ), between( 2, SqrtZ, X ), Y is Z // X, between( X, 99, Y ), Z =:= X * Y.</pre> ====unique_factors( +Product )==== when <var>Product</var> has exactly one pair of factors. <pre class="prolog">unique_factors( Product ) :- ordered_factors( Product, X, _Y ), \+ (ordered_factors(Product, X1, _Y1), X1 =\= X).</pre> ====integer_sqrt( +N, ?Sqrt )==== when <var>Sqrt</var>² &le; <var>N</var> and (<var>Sqrt</var>+1)² &ge; <var>N</var>. <pre class="prolog">integer_sqrt( N, Sqrt ) :- Float is N * 1.0, sqrt( Float, FSqrt ), Sqrt is integer(FSqrt).</pre> Load a small library of [[Puzzle Utilities]]. <pre class="prolog">:- ensure_loaded( misc ).</pre> The code is available as plain text [https://binding-time.co.uk/download/mister_x.txt here]. == Result == This program finds X and Y as '''4''' and '''13'''. == Tabling == Using tabling, rather than explicit lemmas, can simplify code. [https://binding-time.co.uk/download/xsb_mister_x.txt A version adapted for XSB Prolog is available here.] 35bd5be32777d36fdccacdd077de1a2fa2e15d7a 201 174 2018-01-08T12:21:26Z John 2 Tidy up the integer_sqrt/2 specification. wikitext text/x-wiki __NOTOC__ Although this problem has a straightforward solution, it does demonstrate the value of thinking declaratively in understanding the problem, which relates to &ldquo;don't know&rdquo; nondeterminism, and an appropriate use of lemmas. == Problem: == [https://groups.google.com/forum/#!msg/de.comp.lang.java/xQ6T3kZGqcE/-OTNgyB8yxIJ Problem as posted to comp.lang.prolog] by Thorsten Seelend. Also known as Hans Freudenthal's [[wikipedia:Impossible Puzzle|Impossible Puzzle]]. <blockquote>Mister X thinks about two integers between 1 and 100 excluding: </blockquote> =====MISTERX: Two integers, X and Y between 2 and 99 (My formalization of the given information)===== <pre class="prolog">two_integers( X, Y ) :- between( 2, 98, X ), between( X, 99, Y ).</pre> He tells Susan the Sum of them and Peter their Product. Their task is to get the two original values without telling each other the numbers that Mister X told them. <blockquote>After some time Peter says: &ldquo;I can't say definitively which are the original numbers.&rdquo;</blockquote> =====PETER1: There is more than one pair of factors giving Product===== <pre class="prolog">property( peter1, Product ) :- \+ unique_factors( Product ).</pre> <blockquote>Then Susan responds: &ldquo;Neither can I, but I knew that you couldn't know it.&rdquo;</blockquote> =====SUSAN1: The product of ''every'' pair of summands giving Sum has the property PETER1===== <pre class="prolog">property( susan1, Sum ) :- forall( ordered_summands(Sum, X, Y), peter1(X * Y) ).</pre> <blockquote>Peter: &ldquo;Really? So now I know the original numbers&rdquo;.</blockquote> =====PETER2: ''exactly one'' pair of factors giving Product gives a sum with the property SUSAN1===== <pre class="prolog">property( peter2, Product ) :- unique_solution( (ordered_factors(Product, X, Y), susan1(X+Y)) ).</pre> <blockquote>Susan: &ldquo;Now I know them too&rdquo;.</blockquote> =====SUSAN2: ''exactly one'' pair of summands giving Sum has a product with the property PETER2===== <pre class="prolog">property( susan2, Sum ) :- unique_solution( (ordered_summands(Sum, X, Y), peter2(X * Y)) ).</pre> <blockquote>Question: What are the two numbers that Mister X thought of?</blockquote> =====Unique solution===== <pre class="prolog">solve( X, Y ) :- unique_solution( mister_x(X, Y) ). mister_x( X, Y ) :- two_integers( X, Y ), Sum is X + Y, Product is X * Y, peter1( Product ), susan1( Sum ), peter2( Product ), susan2( Sum ).</pre> == Macros == <pre class="prolog">peter1( Product ) :- lemma( peter1, Product ). peter2( Product ) :- lemma( peter2, Product ). susan1( Sum ) :- lemma( susan1, Sum ). susan2( Sum ) :- lemma( susan2, Sum ).</pre> == Lemmas == ====lemma( +Property, +Expression )==== holds wherever <var>Property</var> holds for <var>Expression</var>. Asserted facts are used to record successful (''positive'') or failed (''negative'') demonstrations. This saves recomputation without changing the meaning of the pure program. Although the use of side-effects is generally undesirable, the use of lemmas is justified when the alternative is to compromise performance or clarity. Using lemmas or tabling to cache results is an order of magnitude faster than recalculating each property every time it is used. <pre class="prolog">:- dynamic positive/2, negative/2. lemma( Name, Expression ) :- Value is Expression, ( positive( Value, Name ) -> true ; \+ negative( Value, Name ) -> ( property(Name, Value) -> assert( positive(Value, Name) ) ; otherwise -> assert( negative(Value, Name) ), fail ) ).</pre> == Supporting Predicates == ====ordered_summands( +Sum, ?X, ?Y )==== when <var>X</var> &le; <var>Y</var> and Sum = <var>X</var>+<var>Y</var>. NB: Since <var>X</var>&le;<var>Y</var> it follows that <var>X</var> &le; <var>Sum</var>/2. <pre class="prolog">ordered_summands( Z, X, Y ) :- Half is Z//2, between( 2, Half, X ), Y is Z - X, between( X, 98, Y ).</pre> ====ordered_factors( +Product, ?X, ?Y )==== when <var>X</var> &le; <var>Y</var> and <var>Product</var> = <var>X</var> &times; <var>Y</var>. NB: Since <var>X</var>&le;<var>Y</var> it follows that <var>X</var> &le; &radic;<var>Product</var>. <pre class="prolog">ordered_factors( Z, X, Y ) :- integer_sqrt( Z, SqrtZ ), between( 2, SqrtZ, X ), Y is Z // X, between( X, 99, Y ), Z =:= X * Y.</pre> ====unique_factors( +Product )==== when <var>Product</var> has exactly one pair of factors. <pre class="prolog">unique_factors( Product ) :- ordered_factors( Product, X, _Y ), \+ (ordered_factors(Product, X1, _Y1), X1 =\= X).</pre> ====integer_sqrt( +N, ?Sqrt )==== when <var>Sqrt</var>² &le; <var>N</var> &lt; (<var>Sqrt+1</var>)². <pre class="prolog">integer_sqrt( N, Sqrt ) :- Float is N * 1.0, sqrt( Float, FSqrt ), Sqrt is integer(FSqrt).</pre> Load a small library of [[Puzzle Utilities]]. <pre class="prolog">:- ensure_loaded( misc ).</pre> The code is available as plain text [https://binding-time.co.uk/download/mister_x.txt here]. == Result == This program finds X and Y as '''4''' and '''13'''. == Tabling == Using tabling, rather than explicit lemmas, can simplify code. [https://binding-time.co.uk/download/xsb_mister_x.txt A version adapted for XSB Prolog is available here.] e80e1452e85dbd4bb019c277570ddb080e1d4cc1 0 14 175 127 2017-01-05T22:51:55Z John 2 Remove broken syntax highlighting wikitext text/x-wiki __NOTOC__ <blockquote>Problem posted to [https://groups.google.com/forum/#!msg/comp.lang.prolog/kPfXFcAIBTk/0gYRo84wkSYJ comp.lang.prolog] by Paul Nothman: &ldquo;This problem was recently in a Mathematics competition. Although I completed it through logic and mathematics, without the aid of a computer, I'm wondering if and how it could be answered using prolog.&rdquo; </blockquote> == Problem Statement == The problem is as follows: World theme park has seven attractions which are so far apart that there needs to be a network of monorails, called zoomtracks, to transport the patrons between attractions. There is exactly one zoomtrack between each pair of attractions. Each zoomtrack can only transport patrons in one direction. The network is constructed so that two friends can always meet at a third attraction after exactly one trip each from any two attractions. Hint: Each attraction leads to and is led to by 3 other attractions. There are 21 zoomtracks altogether. Find the entire configuration of the theme park given the following: (The first letter of each line is the attraction from which the zoomtrack comes and the one beside it is where the zoomtrack leads to). SU SO ST UO UN UP OT ON NP TU == Solution Overview == An interesting aspect of this puzzle is the given partial solution. What is its purpose? Is it supposed to help or hinder? In fact, the partial solution allows relatively naive methods to find the right answer in reasonable time. However, I've chosen to implement a method that is not dependent on the partial solution. The key to this approach is the generation of the ''stations'' data-structures, which '''may''' be partially instantiated with the given solution, before the search for a complete solution begins. The requirements of the problem are that each attraction will have three destinations that can be reached by a single zoomtrack, and that every pair of attractions must have a destination in common. This solution uses the insight that every pair of attractions must have '''exactly one''' destination in common. ====zoom==== finds a solution and then prints it. <pre class="prolog">zoom :- zoom_tracks( ZoomTracks ), print_zoom_tracks( ZoomTracks ).</pre> ====zoom_tracks( ?ZoomTracks )==== holds when <var>ZoomTracks</var> is a set of Attraction × Links × Destinations tuples, describing a valid configuration of zoomtracks, such that each pair of attractions has exactly one destination in common. The predicate network/2 always generates viable solutions, but a simple assertion is used to demonstrate that the solution is valid directly. <pre class="prolog">zoom_tracks( ZoomTracks ) :- station_origin( Station, Attraction ), station_destinations( Station, Destinations ), length( Destinations, 3 ), findall( Station, attraction( Attraction ), ZoomTracks ), findall( [Dest,Dest,Dest], attraction( Dest ), PossibleDestinations ), unified_zoomtracks( ZoomTracks ), connections( ZoomTracks ), network( ZoomTracks, PossibleDestinations ), forall( pair_of_stations( ZoomTracks, Station1, Station2 ), friends_can_meet( Station1, Station2 ) ).</pre> ====unified_zoomtracks( +ZoomTracks )==== holds when <var>ZoomTracks</var> is a set of Attraction × Links × Destinations tuples such that each link between two Attractions is represented by a variable shared between the two attractions. In each tuple, the Link variable denoting the Attraction is bound to 'self'. <pre class="prolog">unified_zoomtracks( ZoomTracks ) :- station_origin( First, Attraction1 ), station_origin( Second, Attraction2 ), findall( Attraction1-Attraction2, pair_of_stations(ZoomTracks, First, Second), Linkage ), unified_links( Linkage, ZoomTracks ).</pre> ====unified_links( +Linkage, +ZoomTracks )==== holds when <var>Linkage</var> is a list of Attraction1-Attraction2 pairs such that in <var>ZoomTracks</var>: * The link variables denoting Attraction1 for Attraction2 and vice versa are unified. * The link variables denoting Attraction1 for Attraction1 and Attraction2 for Attraction2 are bound to 'self'. <pre class="prolog">unified_links( [], _ZoomTracks ). unified_links( [First-Second|Linkage], ZoomTracks ) :- station_origin( Station1, First ), station_links( Station1, Links1 ), station_origin( Station2, Second ), station_links( Station2, Links2 ), memberchk( Station1, ZoomTracks ), memberchk( Station2, ZoomTracks ), link_receiver( First, Links2, Receiver ), link_receiver( Second, Links1, Receiver ), link_receiver( First, Links1, self ), link_receiver( Second, Links2, self ), unified_links( Linkage, ZoomTracks ).</pre> ====connections( ?ZoomTracks )==== holds when the given connections have been applied to <var>ZoomTracks</var>. Note that this can be made vacuous without any significant effect on performance. <pre class="prolog">connections( ZoomTracks ) :- connection( s, u, ZoomTracks ), connection( s, o, ZoomTracks ), connection( s, t, ZoomTracks ), connection( u, o, ZoomTracks ), connection( u, n, ZoomTracks ), connection( u, p, ZoomTracks ), connection( o, t, ZoomTracks ), connection( o, n, ZoomTracks ), connection( n, p, ZoomTracks ), connection( t, u, ZoomTracks ).</pre> ====connection( +Source, +Destination, +ZoomTracks )==== holds when <var>ZoomTracks</var> contains a connection from <var>Source</var> to <var>Destination</var>. <pre class="prolog">connection( From, To, ZoomTracks ) :- station_origin( Station, From ), station_links( Station, Links ), station_destinations( Station, Destinations ), memberchk( Station, ZoomTracks ), memberchk( To, Destinations ), link_receiver( To, Links, To ).</pre> ====pair_of_stations( +ZoomTracks, ?Station1, ?Station2 )==== holds when <var>Station1</var> and <var>Station2</var> are distinct elements of <var>ZoomTracks</var>, avoiding redundant solutions. <pre class="prolog">pair_of_stations( [Station1|ZoomTracks], Station1, Station2 ) :- member( Station2, ZoomTracks ). pair_of_stations( [_Station0|ZoomTracks], Station1, Station2 ) :- pair_of_stations( ZoomTracks, Station1, Station2 ).</pre> ====friends_can_meet( +Station1, +Station2 )==== holds when <var>Station1</var> and <var>Station2</var> have a common destination. <pre class="prolog">friends_can_meet( Station1, Station2 ) :- station_destinations( Station1, Destinations1 ), station_destinations( Station2, Destinations2 ), member( MeetingPoint, Destinations1 ), member( MeetingPoint, Destinations2 ).</pre> ====network( +ZoomTracks, ?Destinations )==== holds when <var>ZoomTracks</var> is a set of Attraction &rarr; Destinations pairs describing a valid configuration of zoomtracks, such that each pair of attractions has exactly one destination in common. <var>Destinations</var> define the range of <var>ZoomTracks</var>. <pre class="prolog">network( ZoomTracks, Destinations ) :- network1( ZoomTracks, Destinations, [] ). network1( [], Destinations, _Stations ) :- forall( member( Empty, Destinations ), Empty == [] ). network1( [Station|Stations], Destinations, Assigned ) :- destination_assignment( Station, Destinations, Destinations1 ), properly_connected( Station, Assigned ), network1( Stations, Destinations1, [Station|Assigned] ).</pre> ====destination_assignment( +Station, +Destinations, ?Destinations1 )==== holds when <var>Destinations1</var> is the difference of <var>Destinations</var> and the destinations of <var>Station</var>, which must not contain the origin of <var>Station</var>. <pre class="prolog">destination_assignment( Station, Destinations0, Destinations1 ) :- station_destinations( Station, Destinations ), station_links( Station, Links ), matching( Destinations, Links, Destinations0, Destinations1 ).</pre> ====matching( +Destinations0, +Links, +Destinations1, ?Destinations2 )==== holds when <var>Destinations2</var> is the difference of <var>Destinations0</var> and <var>Destinations1</var>, and the <var>Links</var> variables corresponding to <var>Destinations0</var> are instantiated. <pre class="prolog">matching( [], _Links, Destinations, Destinations ). matching( [Destination|Destinations], Links, Destinations0, [Rest|Destinations1] ) :- select( [Destination|Rest], Destinations0, Destinations2 ), link_receiver( Destination, Links, Destination ), matching( Destinations, Links, Destinations2, Destinations1 ).</pre> ====properly_connected( +Station, +Stations )==== holds when <var>Station</var> and each member of <var>Stations</var> have exactly one destination in common. <pre class="prolog">properly_connected( Station, Stations ) :- station_destinations( Station, Destinations ), station_destinations( Station1, Destinations1 ), forall( member( Station1, Stations ), one_common_member( Destinations, Destinations1 ) ).</pre> ====one_common_member( ?Set0, ?Set1 )==== holds when <var>Set0</var> and <var>Set1</var> have exactly one common member. <pre class="prolog">one_common_member( Set0, Set1 ) :- select( Member, Set0, Residue0 ), select( Member, Set1, Residue1 ), \+ common_member( Residue0, Residue1 ).</pre> ====common_member( ?Set0, ?Set1 )==== holds when <var>Set0</var> and <var>Set1</var> have a common member. <pre class="prolog">common_member( Set0, Set1 ) :- member( Member, Set0 ), member( Member, Set1 ).</pre> === Data Abstraction === <pre class="prolog">attraction( Name ) :- link_receiver( Name, _Links, _Value ). link_receiver( s, links( S,_U,_O,_N,_T,_P,_Q), S ). link_receiver( u, links(_S, U,_O,_N,_T,_P,_Q), U ). link_receiver( o, links(_S,_U, O,_N,_T,_P,_Q), O ). link_receiver( n, links(_S,_U,_O, N,_T,_P,_Q), N ). link_receiver( t, links(_S,_U,_O,_N, T,_P,_Q), T ). link_receiver( p, links(_S,_U,_O,_N,_T ,P,_Q), P ). link_receiver( q, links(_S,_U,_O,_N,_T,_P, Q), Q ). station_destinations( zoom(_Name, _Links, Destinations), Destinations ). station_links( zoom(_Name, Links, _Destinations), Links ). station_origin( zoom(Name, _Links, _Destinations), Name ).</pre> ==Utility Predicates== Load a small library of [[Puzzle Utilities]]. <pre class="prolog">:- ensure_loaded( misc ).</pre> ====print_zoom_tracks( +ZoomTracks )==== prints all the links in <var>ZoomTracks</var> as origin - destination pairs of stations. <pre class="prolog">print_zoom_tracks( [] ). print_zoom_tracks( [ZoomTrack|ZoomTracks] ) :- station_origin( ZoomTrack, Origin ), station_destinations( ZoomTrack, Destinations ), print_zoom_track_links( Destinations, Origin ), print_zoom_tracks( ZoomTracks ). print_zoom_track_links( [], _Origin ). print_zoom_track_links( [Destination|Destinations], Origin ) :- format( '~w~w~n', [Origin,Destination] ), print_zoom_track_links( Destinations, Origin ).</pre> The code is available as plain text [https://binding-time.co.uk/download/zoom_tracks.txt here]. ==Result== <pre class="Result">| ?- zoom. su so st uo un up ot on oq np nt ns tu tp tq pq ps po qs qu qn yes</pre> a64247f459724c066e5e611dcba437390adfa559 195 175 2017-10-13T00:04:16Z John 2 remove format/2 for portability. wikitext text/x-wiki __NOTOC__ <blockquote>Problem posted to [https://groups.google.com/forum/#!msg/comp.lang.prolog/kPfXFcAIBTk/0gYRo84wkSYJ comp.lang.prolog] by Paul Nothman: &ldquo;This problem was recently in a Mathematics competition. Although I completed it through logic and mathematics, without the aid of a computer, I'm wondering if and how it could be answered using prolog.&rdquo; </blockquote> == Problem Statement == The problem is as follows: World theme park has seven attractions which are so far apart that there needs to be a network of monorails, called zoomtracks, to transport the patrons between attractions. There is exactly one zoomtrack between each pair of attractions. Each zoomtrack can only transport patrons in one direction. The network is constructed so that two friends can always meet at a third attraction after exactly one trip each from any two attractions. Hint: Each attraction leads to and is led to by 3 other attractions. There are 21 zoomtracks altogether. Find the entire configuration of the theme park given the following: (The first letter of each line is the attraction from which the zoomtrack comes and the one beside it is where the zoomtrack leads to). SU SO ST UO UN UP OT ON NP TU == Solution Overview == An interesting aspect of this puzzle is the given partial solution. What is its purpose? Is it supposed to help or hinder? In fact, the partial solution allows relatively naive methods to find the right answer in reasonable time. However, I've chosen to implement a method that is not dependent on the partial solution. The key to this approach is the generation of the ''stations'' data-structures, which '''may''' be partially instantiated with the given solution, before the search for a complete solution begins. The requirements of the problem are that each attraction will have three destinations that can be reached by a single zoomtrack, and that every pair of attractions must have a destination in common. This solution uses the insight that every pair of attractions must have '''exactly one''' destination in common. ====zoom==== finds a solution and then prints it. <pre class="prolog">zoom :- zoom_tracks( ZoomTracks ), print_zoom_tracks( ZoomTracks ).</pre> ====zoom_tracks( ?ZoomTracks )==== holds when <var>ZoomTracks</var> is a set of Attraction × Links × Destinations tuples, describing a valid configuration of zoomtracks, such that each pair of attractions has exactly one destination in common. The predicate network/2 always generates viable solutions, but a simple assertion is used to demonstrate that the solution is valid directly. <pre class="prolog">zoom_tracks( ZoomTracks ) :- station_origin( Station, Attraction ), station_destinations( Station, Destinations ), length( Destinations, 3 ), findall( Station, attraction( Attraction ), ZoomTracks ), findall( [Dest,Dest,Dest], attraction( Dest ), PossibleDestinations ), unified_zoomtracks( ZoomTracks ), connections( ZoomTracks ), network( ZoomTracks, PossibleDestinations ), forall( pair_of_stations( ZoomTracks, Station1, Station2 ), friends_can_meet( Station1, Station2 ) ).</pre> ====unified_zoomtracks( +ZoomTracks )==== holds when <var>ZoomTracks</var> is a set of Attraction × Links × Destinations tuples such that each link between two Attractions is represented by a variable shared between the two attractions. In each tuple, the Link variable denoting the Attraction is bound to 'self'. <pre class="prolog">unified_zoomtracks( ZoomTracks ) :- station_origin( First, Attraction1 ), station_origin( Second, Attraction2 ), findall( Attraction1-Attraction2, pair_of_stations(ZoomTracks, First, Second), Linkage ), unified_links( Linkage, ZoomTracks ).</pre> ====unified_links( +Linkage, +ZoomTracks )==== holds when <var>Linkage</var> is a list of Attraction1-Attraction2 pairs such that in <var>ZoomTracks</var>: * The link variables denoting Attraction1 for Attraction2 and vice versa are unified. * The link variables denoting Attraction1 for Attraction1 and Attraction2 for Attraction2 are bound to 'self'. <pre class="prolog">unified_links( [], _ZoomTracks ). unified_links( [First-Second|Linkage], ZoomTracks ) :- station_origin( Station1, First ), station_links( Station1, Links1 ), station_origin( Station2, Second ), station_links( Station2, Links2 ), memberchk( Station1, ZoomTracks ), memberchk( Station2, ZoomTracks ), link_receiver( First, Links2, Receiver ), link_receiver( Second, Links1, Receiver ), link_receiver( First, Links1, self ), link_receiver( Second, Links2, self ), unified_links( Linkage, ZoomTracks ).</pre> ====connections( ?ZoomTracks )==== holds when the given connections have been applied to <var>ZoomTracks</var>. Note that this can be made vacuous without any significant effect on performance. <pre class="prolog">connections( ZoomTracks ) :- connection( s, u, ZoomTracks ), connection( s, o, ZoomTracks ), connection( s, t, ZoomTracks ), connection( u, o, ZoomTracks ), connection( u, n, ZoomTracks ), connection( u, p, ZoomTracks ), connection( o, t, ZoomTracks ), connection( o, n, ZoomTracks ), connection( n, p, ZoomTracks ), connection( t, u, ZoomTracks ).</pre> ====connection( +Source, +Destination, +ZoomTracks )==== holds when <var>ZoomTracks</var> contains a connection from <var>Source</var> to <var>Destination</var>. <pre class="prolog">connection( From, To, ZoomTracks ) :- station_origin( Station, From ), station_links( Station, Links ), station_destinations( Station, Destinations ), memberchk( Station, ZoomTracks ), memberchk( To, Destinations ), link_receiver( To, Links, To ).</pre> ====pair_of_stations( +ZoomTracks, ?Station1, ?Station2 )==== holds when <var>Station1</var> and <var>Station2</var> are distinct elements of <var>ZoomTracks</var>, avoiding redundant solutions. <pre class="prolog">pair_of_stations( [Station1|ZoomTracks], Station1, Station2 ) :- member( Station2, ZoomTracks ). pair_of_stations( [_Station0|ZoomTracks], Station1, Station2 ) :- pair_of_stations( ZoomTracks, Station1, Station2 ).</pre> ====friends_can_meet( +Station1, +Station2 )==== holds when <var>Station1</var> and <var>Station2</var> have a common destination. <pre class="prolog">friends_can_meet( Station1, Station2 ) :- station_destinations( Station1, Destinations1 ), station_destinations( Station2, Destinations2 ), member( MeetingPoint, Destinations1 ), member( MeetingPoint, Destinations2 ).</pre> ====network( +ZoomTracks, ?Destinations )==== holds when <var>ZoomTracks</var> is a set of Attraction &rarr; Destinations pairs describing a valid configuration of zoomtracks, such that each pair of attractions has exactly one destination in common. <var>Destinations</var> define the range of <var>ZoomTracks</var>. <pre class="prolog">network( ZoomTracks, Destinations ) :- network1( ZoomTracks, Destinations, [] ). network1( [], Destinations, _Stations ) :- forall( member( Empty, Destinations ), Empty == [] ). network1( [Station|Stations], Destinations, Assigned ) :- destination_assignment( Station, Destinations, Destinations1 ), properly_connected( Station, Assigned ), network1( Stations, Destinations1, [Station|Assigned] ).</pre> ====destination_assignment( +Station, +Destinations, ?Destinations1 )==== holds when <var>Destinations1</var> is the difference of <var>Destinations</var> and the destinations of <var>Station</var>, which must not contain the origin of <var>Station</var>. <pre class="prolog">destination_assignment( Station, Destinations0, Destinations1 ) :- station_destinations( Station, Destinations ), station_links( Station, Links ), matching( Destinations, Links, Destinations0, Destinations1 ).</pre> ====matching( +Destinations0, +Links, +Destinations1, ?Destinations2 )==== holds when <var>Destinations2</var> is the difference of <var>Destinations0</var> and <var>Destinations1</var>, and the <var>Links</var> variables corresponding to <var>Destinations0</var> are instantiated. <pre class="prolog">matching( [], _Links, Destinations, Destinations ). matching( [Destination|Destinations], Links, Destinations0, [Rest|Destinations1] ) :- select( [Destination|Rest], Destinations0, Destinations2 ), link_receiver( Destination, Links, Destination ), matching( Destinations, Links, Destinations2, Destinations1 ).</pre> ====properly_connected( +Station, +Stations )==== holds when <var>Station</var> and each member of <var>Stations</var> have exactly one destination in common. <pre class="prolog">properly_connected( Station, Stations ) :- station_destinations( Station, Destinations ), station_destinations( Station1, Destinations1 ), forall( member( Station1, Stations ), one_common_member( Destinations, Destinations1 ) ).</pre> ====one_common_member( ?Set0, ?Set1 )==== holds when <var>Set0</var> and <var>Set1</var> have exactly one common member. <pre class="prolog">one_common_member( Set0, Set1 ) :- select( Member, Set0, Residue0 ), select( Member, Set1, Residue1 ), \+ common_member( Residue0, Residue1 ).</pre> ====common_member( ?Set0, ?Set1 )==== holds when <var>Set0</var> and <var>Set1</var> have a common member. <pre class="prolog">common_member( Set0, Set1 ) :- member( Member, Set0 ), member( Member, Set1 ).</pre> === Data Abstraction === <pre class="prolog">attraction( Name ) :- link_receiver( Name, _Links, _Value ). link_receiver( s, links( S,_U,_O,_N,_T,_P,_Q), S ). link_receiver( u, links(_S, U,_O,_N,_T,_P,_Q), U ). link_receiver( o, links(_S,_U, O,_N,_T,_P,_Q), O ). link_receiver( n, links(_S,_U,_O, N,_T,_P,_Q), N ). link_receiver( t, links(_S,_U,_O,_N, T,_P,_Q), T ). link_receiver( p, links(_S,_U,_O,_N,_T ,P,_Q), P ). link_receiver( q, links(_S,_U,_O,_N,_T,_P, Q), Q ). station_destinations( zoom(_Name, _Links, Destinations), Destinations ). station_links( zoom(_Name, Links, _Destinations), Links ). station_origin( zoom(Name, _Links, _Destinations), Name ).</pre> ==Utility Predicates== Load a small library of [[Puzzle Utilities]]. <pre class="prolog">:- ensure_loaded( misc ).</pre> ====print_zoom_tracks( +ZoomTracks )==== prints all the links in <var>ZoomTracks</var> as origin - destination pairs of stations. <pre class="prolog">print_zoom_tracks( [] ). print_zoom_tracks( [ZoomTrack|ZoomTracks] ) :- station_origin( ZoomTrack, Origin ), station_destinations( ZoomTrack, Destinations ), print_zoom_track_links( Destinations, Origin ), print_zoom_tracks( ZoomTracks ). print_zoom_track_links( [], _Origin ). print_zoom_track_links( [Destination|Destinations], Origin ) :- write( Origin ), write( Destination ), nl, print_zoom_track_links( Destinations, Origin ).</pre> The code is available as plain text [https://binding-time.co.uk/download/zoom_tracks.txt here]. ==Result== <pre class="Result">| ?- zoom. su so st uo un up ot on oq np nt ns tu tp tq pq ps po qs qu qn yes</pre> bcec73a14ca10c9f330044b7e1fded4d15b47c19 0 15 176 128 2017-01-05T22:54:12Z John 2 Remove broken syntax highlighting wikitext text/x-wiki __NOTOC__ ==Problem Statement== <blockquote><div>Problem posted to [https://groups.google.com/forum/#!msg/comp.lang.prolog/h2wy7VjCdEI/BzD3yB88K7oJ comp.lang.prolog] by Nimesh777@aol.com</div> M has been murdered. A, B and C are suspects. * A says he is innocent, B was M's friend but C hated M. * B says that he was out of town on the day of the murder, besides he didn't even know M. * C says he is innocent but he saw A &amp; B with M just before the murder. Assuming that all except possibly the murderer are telling the truth, solve the crime. </blockquote> ==Solution== <blockquote cite=""> When you have eliminated the impossible, whatever remains, however improbable, must be the truth. <cite>[http://www.gutenberg.org/ebooks/2097 Sir Arthur Conan Doyle - The Sign of the Four]</cite> </blockquote> ==== solve_murder( ?Murderer ) ==== Solving the crime means finding the <var>Murderer</var>'s identity, such that the <var>Murderer</var>'s statement is the only one that is inconsistent with the statements of the other suspects. <pre class="prolog">solve_murder( Murderer ) :- unique_solution( murderer( Murderer ) ).</pre> Firstly, the suspects' statements are formalized: <pre class="prolog">statement( a ) --> [innocent(a),friend(b,m),hates(c,m)]. statement( b ) --> [alibi(b),not_know(b,m)]. statement( c ) --> [innocent(c),with(c,m),with(b,m),with(a,m)]. statements( [] ) --> []. statements( [Witness|Witnesses] ) --> statement( Witness ), statements( Witnesses ).</pre> Then we define mutual-exclusivity between assertions. <pre class="prolog">mutually_exclusive( [friend(X,Y), hates(X,Y), not_know(X,Y)] ). mutually_exclusive( [innocent(X), guilty(X)] ). mutually_exclusive( [alibi(X), with(X,m)] ). mutually_exclusive( [alibi(X), with(m,X)] ). mutually_exclusive( [alibi(X), guilty(X)] ).</pre> The murderer is identified by showing that the statements of the other suspects (witnesses) are consistent with each other, and with the murderer being guilty. <pre class="prolog">murderer( Murderer ) :- Suspects = [a,b,c], select( Murderer, Suspects, Witnesses ), phrase( statements(Witnesses), Assertions ), consistent( [guilty(Murderer)|Assertions] ).</pre> A set of assertions is consistent if no inconsistency can be found between any member and the rest of the set. <pre class="prolog">consistent( Statements ) :- \+ inconsistent( Statements ).</pre> An assertion is inconsistent with a set of assertions if it is pairwise exclusive with a member of the set. <pre class="prolog">inconsistent( [Assertion|Assertions] ) :- mutually_exclusive( Exclusive ), select( Assertion, Exclusive, Inconsistent ), member( Inconsistency, Inconsistent ), member( Inconsistency, Assertions ). inconsistent( [_Assertion|Assertions] ) :- inconsistent( Assertions ).</pre> Load a small library of [[Puzzle Utilities]]. <pre class="prolog">:- ensure_loaded( misc ).</pre> The code is available as plain text [https://binding-time.co.uk/download/whodunit.txt here]. ==Result== <pre>?- solve_murder( Murderer ). Murderer = b</pre> 1586de1d5876cd3f02b603d42af88c0cfaca8349 0 18 179 122 2017-01-05T23:01:06Z John 2 Remove broken syntax highlighting wikitext text/x-wiki __NOTOC__ The following is a complete example to illustrate how the xml.pl module can be used. It exercises both the input and output parsing modes of <code>xml_parse/[2,3]</code>, and illustrates the use of <code>xml_subterm/2</code> to access the nodes of a &ldquo;document value model&rdquo;. It's written for Quintus Prolog, but should port to other Prologs easily. ====test( +QueryId )==== The <code>test/1</code> predicate is the entry-point of the program and executes a Prolog implementation of a Query from [http://www.w3.org/TR/xquery-use-cases/#xmp Use Case &ldquo;XMP&rdquo;: Experiences and Exemplars], in the W3C's XML Query Use Cases, which &ldquo;contains several example queries that illustrate requirements gathered from the database and document communities&rdquo;. <var>QueryId</var> is one of <code>q1</code>...<code>q12</code> selecting which of the 12 use cases is executed. The XML output is written to the file [QueryId].xml in the current directory. <code>xml_pp/1</code> is used to display the resulting &ldquo;document value model&rdquo; data-structures on the user output (stdout) stream. <pre class="prolog">test( Query ) :- xml_query( Query, ResultElement ), % Parse output XML into the Output chars xml_parse( Output, xml([], [ResultElement]) ), absolute_file_name( Query, [extensions(xml)], OutputFile ), % Write OutputFile from the Output list of chars tell( OutputFile ), put_chars( Output ), told, % Pretty print OutputXML write( 'Output XML' ), nl, xml_pp( xml([], [ResultElement]) ).</pre> ====xml_query( +QueryNo, ?OutputXML )==== when <var>OutputXML</var> is an XML Document Value Model produced by running an example, identified by <var>QueryNo</var>, taken from the XML Query &ldquo;XMP&rdquo; use case. ===Q1=== List books published by Addison-Wesley after 1991, including their year and title. <pre class="prolog">xml_query( q1, element(bib, [], Books) ) :- element_name( Title, title ), element_name( Publisher, publisher ), input_document( 'bib.xml', Bibliography ), findall( element(book, [year=Year], [Title]), ( xml_subterm( Bibliography, element(book, Attributes, Content) ), xml_subterm( Content, Publisher ), xml_subterm( Publisher, Text ), text_value( Text, "Addison-Wesley" ), member( year=Year, Attributes ), number_codes( YearNo, Year ), YearNo > 1991, xml_subterm( Content, Title ) ), Books ).</pre> ===Q2=== Create a flat list of all the title-author pairs, with each pair enclosed in a &ldquo;result&rdquo; element. <pre class="prolog">xml_query( q2, element(results, [], Results) ) :- element_name( Title, title ), element_name( Author, author ), element_name( Book, book ), input_document( 'bib.xml', Bibliography ), findall( element(result, [], [Title,Author]), ( xml_subterm( Bibliography, Book ), xml_subterm( Book, Title ), xml_subterm( Book, Author ) ), Results ).</pre> ===Q3=== For each book in the bibliography, list the title and authors, grouped inside a &ldquo;result&rdquo; element. <pre class="prolog">xml_query( q3, element(results, [], Results) ) :- element_name( Title, title ), element_name( Author, author ), element_name( Book, book ), input_document( 'bib.xml', Bibliography ), findall( element(result, [], [Title|Authors]), ( xml_subterm( Bibliography, Book ), xml_subterm( Book, Title ), findall( Author, xml_subterm(Book, Author), Authors ) ), Results ).</pre> ===Q4=== For each author in the bibliography, list the author's name and the titles of all books by that author, grouped inside a &ldquo;result&rdquo; element. <pre class="prolog">xml_query( q4, element(results, [], Results) ) :- element_name( Title, title ), element_name( Author, author ), element_name( Book, book ), input_document( 'bib.xml', Bibliography ), findall( Author, xml_subterm(Bibliography, Author), AuthorBag ), sort( AuthorBag, Authors ), findall( element(result, [], [Author|Titles]), ( member( Author, Authors ), findall( Title, ( xml_subterm( Bibliography, Book ), xml_subterm( Book, Author ), xml_subterm( Book, Title ) ), Titles ) ), Results ).</pre> ===Q5=== For each book found at both bn.com and amazon.com, list the title of the book and its price from each source. <pre class="prolog">xml_query( q5, element('books-with-prices', [], BooksWithPrices) ) :- element_name( Title, title ), element_name( Book, book ), element_name( Review, entry ), input_document( 'bib.xml', Bibliography ), input_document( 'reviews.xml', Reviews ), findall( element('book-with-prices', [], [ Title, element('price-bn',[], BNPrice ), element('price-amazon',[], AmazonPrice ) ] ), ( xml_subterm( Bibliography, Book ), xml_subterm( Book, Title ), xml_subterm( Reviews, Review ), xml_subterm( Review, Title ), xml_subterm( Book, element(price,_, BNPrice) ), xml_subterm( Review, element(price,_, AmazonPrice) ) ), BooksWithPrices ).</pre> ===Q6=== For each book that has at least one author, list the title and first two authors, and an empty &ldquo;et-al&rdquo; element if the book has additional authors. <pre class="prolog">xml_query( q6, element(bib, [], Results) ) :- element_name( Title, title ), element_name( Author, author ), element_name( Book, book ), input_document( 'bib.xml', Bibliography ), findall( element(book, [], [Title,FirstAuthor|Authors]), ( xml_subterm( Bibliography, Book ), xml_subterm( Book, Title ), findall( Author, xml_subterm(Book, Author), [FirstAuthor|Others] ), other_authors( Others, Authors ) ), Results ).</pre> ===Q7=== List the titles and years of all books published by Addison-Wesley after 1991, in alphabetic order. <pre class="prolog">xml_query( q7, element(bib, [], Books) ) :- element_name( Title, title ), element_name( Publisher, publisher ), input_document( 'bib.xml', Bibliography ), findall( Title-element(book, [year=Year], [Title]), ( xml_subterm( Bibliography, element(book, Attributes, Book) ), xml_subterm( Book, Publisher ), xml_subterm( Publisher, Text ), text_value( Text, "Addison-Wesley" ), member( year=Year, Attributes ), number_codes( YearNo, Year ), YearNo > 1991, xml_subterm( Book, Title ) ), TitleBooks ), keysort( TitleBooks, TitleBookSet ), range( TitleBookSet, Books ).</pre> ===Q8=== Find books in which the name of some element ends with the string &ldquo;or&rdquo; and the same element contains the string &ldquo;Suciu&rdquo; somewhere in its content. For each such book, return the title and the qualifying element. <pre class="prolog">xml_query( q8, element(bib, [], Books) ) :- element_name( Title, title ), element_name( Book, book ), element_name( QualifyingElement, QualifyingName ), append( "Suciu", _Back, Suffix ), input_document( 'bib.xml', Bibliography ), findall( element(book, [], [Title,QualifyingElement]), ( xml_subterm( Bibliography, Book ), xml_subterm( Book, QualifyingElement ), atom_codes( QualifyingName, QNChars ), append( _QNPrefix, "or", QNChars ), xml_subterm( QualifyingElement, TextItem ), text_value( TextItem, TextValue ), append( _Prefix, Suffix, TextValue ), xml_subterm( Book, Title ) ), Books ).</pre> ===Q9=== In the document &ldquo;books.xml&rdquo;, find all section or chapter titles that contain the word &ldquo;XML&rdquo;, regardless of the level of nesting. <pre class="prolog">xml_query( q9, element(results, [], Titles) ) :- element_name( Title, title ), append( "XML", _Back, Suffix ), input_document( 'books.xml', Books ), findall( Title, ( xml_subterm( Books, Title ), xml_subterm( Title, TextItem ), text_value( TextItem, TextValue ), append( _Prefix, Suffix, TextValue ) ), Titles ).</pre> ===Q10=== In the document &ldquo;prices.xml&rdquo;, find the minimum price for each book, in the form of a &ldquo;minprice&rdquo; element with the book title as its title attribute. <pre class="prolog">xml_query( q10, element(results, [], MinPrices) ) :- element_name( Title, title ), element_name( Price, price ), input_document( 'prices.xml', Prices ), findall( Title, xml_subterm(Prices, Title), TitleBag ), sort( TitleBag, TitleSet ), element_name( Book, book ), findall( element(minprice, [title=TitleString], [MinPrice]), ( member( Title, TitleSet ), xml_subterm( Title, TitleText ), text_value( TitleText, TitleString ), findall( PriceValue-Price, ( xml_subterm( Prices, Book ), xml_subterm( Book, Title ), xml_subterm( Book, Price ), xml_subterm( Price, Text ), text_value( Text, PriceChars ), number_codes( PriceValue, PriceChars ) ), PriceValues ), minimum( PriceValues, PriceValue-MinPrice ) ), MinPrices ).</pre> ===Q11=== For each book with an author, return the book with its title and authors. For each book with an editor, return a reference with the book title and the editor's affiliation. <pre class="prolog">xml_query( q11, element(bib, [], Results) ) :- element_name( Title, title ), element_name( Author, author ), element_name( Book, book ), element_name( Editor, editor ), element_name( Affiliation, affiliation ), input_document( 'bib.xml', Bibliography ), findall( element(book, [], [Title,FirstAuthor|Authors]), ( xml_subterm( Bibliography, Book ), xml_subterm( Book, Title ), findall( Author, xml_subterm(Book, Author), [FirstAuthor|Authors] ) ), Books ), findall( element(reference, [], [Title,Affiliation]), ( xml_subterm( Bibliography, Book ), xml_subterm( Book, Title ), xml_subterm( Book, Editor ), xml_subterm( Editor, Affiliation ) ), References ), append( Books, References, Results ).</pre> ===Q12=== Find pairs of books that have different titles but the same set of authors (possibly in a different order). <pre class="prolog">xml_query( q12, element(bib, [], Pairs) ) :- element_name( Author, author ), element_name( Book1, book ), element_name( Book2, book ), element_name( Title1, title ), element_name( Title2, title ), input_document( 'bib.xml', Bibliography ), findall( element('book-pair', [], [Title1,Title2]), ( xml_subterm( Bibliography, Book1 ), findall( Author, xml_subterm(Book1, Author), AuthorBag1 ), sort( AuthorBag1, AuthorSet ), xml_subterm( Bibliography, Book2 ), Book2 @< Book1, findall( Author, xml_subterm(Book2, Author), AuthorBag2 ), sort( AuthorBag2, AuthorSet ), xml_subterm( Book1, Title1 ), xml_subterm( Book2, Title2 ) ), Pairs ).</pre> == Auxiliary Predicates == <pre class="prolog">other_authors( [], [] ). other_authors( [Author|Authors], [Author|EtAl] ) :- et_al( Authors, EtAl ). et_al( [], [] ). et_al( [_|_], [element('et-al',[],[])] ). text_value( [pcdata(Text)], Text ). text_value( [cdata(Text)], Text ). element_name( element(Name, _Attributes, _Content), Name ).</pre> ====range( +Pairs, ?Range )==== when <var>Pairs</var> is a list of key-datum pairs and <var>Range</var> is the list of data. <pre class="prolog">range( [], [] ). range( [_Key-Datum|Pairs], [Datum|Data] ) :- range( Pairs, Data ).</pre> ====minimum( +List, ?Min )==== is true if <var>Min</var> is the least member of <var>List</var> in the standard order. <pre class="prolog">minimum( [H|T], Min ):- minimum1( T, H, Min ). minimum1( [], Min, Min ). minimum1( [H|T], Min0, Min ) :- compare( Relation, H, Min0 ), minimum2( Relation, H, Min0, T, Min ). minimum2( '=', Min0, Min0, T, Min ) :- minimum1( T, Min0, Min ). minimum2( '<', Min0, _Min1, T, Min ) :- minimum1( T, Min0, Min ). minimum2( '>', _Min0, Min1, T, Min ) :- minimum1( T, Min1, Min ).</pre> ====input_document( +File, ?XML )==== reads <var>File</var> and parses the input into the &ldquo;Document Value Model&rdquo; <var>XML</var>. <pre class="prolog">input_document( File, XML ) :- % Read InputFile as a list of chars see( File ), get_chars( Input ), seen, % Parse the Input chars into the term XML xml_parse( Input, XML ).</pre> Load the [[XML Module]]. <pre class="prolog">:- use_module( xml ).</pre> Load a small library of [[Puzzle Utilities]]. <pre class="prolog"> :- ensure_loaded( misc ). </pre> Download a 5Kb tar.gz format [https://binding-time.co.uk/download/xml_example.tar.gz file containing this program with input and output data]. 9d6356b344708ea73b646a2ce38c5833bd2ca346 0 12 180 47 2017-01-05T23:13:29Z John 2 Remove broken syntax highlighting wikitext text/x-wiki The following predicates are used in the puzzle solutions. ==Higher-order Predicates== ====unique_solution( +Goal )==== holds when <var>Goal</var> has one ground solution. Operationally, <var>Goal</var> may produce several solutions, ("don't care" non-deterministically), but they must all be identical (<code>==</code>). <pre class="prolog">unique_solution( Goal ) :- findall( Goal, Goal, [Solution|Solutions] ), same_solution( Solutions, Solution ), Solution = Goal. same_solution( [], _Solution ). same_solution( [Solution0|Solutions], Solution ) :- Solution0 == Solution, same_solution( Solutions, Solution ).</pre> ====forall( +Enumerator, +Test )==== is true if <var>Enumerator</var> and <var>Test</var> are goals and <var>Test</var> holds everywhere that <var>Enumerator</var> does. NB: forall/2 does not instantiate arguments further. <pre class="prolog">forall( Enumerator, Test ) :- \+ (call(Enumerator), \+ call(Test)).</pre> ====count_solutions( +Goal, ?Count )==== is true if <var>Count</var> is the number of solutions for <var>Goal</var>. The solutions might not be distinct. <code>count_solutions/2</code> enumerates the possible solutions to <var>Goal</var> but does not instantiate <var>Goal</var>'s arguments further. <pre class="prolog"> count_solutions( Goal, Count ) :- findall( x, Goal, Xs ), length( Xs, Count ). </pre> ==Lists== ====member( ?Element, ?List )==== holds when <var>Element</var> is a member of <var>List</var>. <pre class="prolog">member( H, [H|_] ). member( H, [_|T] ) :- member( H, T ).</pre> ====select( ?Element, ?List0, ?List1 )==== is true if <var>List1</var> is equal to <var>List0</var> with <var>Element</var> removed. <pre class="prolog">select( H, [H|T], T ). select( Element, [H|T0], [H|T1] ) :- select( Element, T0, T1 ).</pre> ====memberchk( +Element, +List )==== succeeds (once) if <var>Element</var> is a member of <var>List</var>. <pre class="prolog">memberchk( Element, List ) :- member( Element, List ), !.</pre> ==Arithmetic== ====between( +Lower, +Upper, ?Index )==== is true if <var>Lower</var> =< <var>Index</var> =< <var>Upper</var>. Two valid cases are possible: * <var>Index</var> is already instantiated to an integer, so the checks on order are applied (test). * <var>Index</var> is a logical variable: a series of alternative solutions may be generated as the monotonic sequence of values between <var>Lower</var> and <var>Upper</var> (non-deterministic generator). <pre class="prolog">between( Lower, Upper, Index ) :- integer( Lower ), integer( Upper ), Lower =< Upper, ( integer( Index ) -> % Case 1: "test" Index >= Lower, Index =< Upper ; var( Index ) -> % Case 2: "generate". generate_between( Lower, Upper, Index ) ). generate_between( Lower, Upper, Index ) :- ( Lower =:= Upper -> Index = Lower ; Index = Lower ; Next is Lower + 1, Next =< Upper, generate_between( Next, Upper, Index ) ).</pre> ====sum( +List, ?Sum )==== holds when the <var>List</var> of numbers sum to <var>Sum</var>. <pre class="prolog">sum( [H|T], Sum ) :- sum1( T, H, Sum ). sum1( [], Sum, Sum ). sum1( [H|T], Sum0, Sum ):- Sum1 is Sum0 + H, sum1( T, Sum1, Sum ).</pre> ==Character Input/Output== ====put_chars( +Chars )==== if <var>Chars</var> is a (possibly empty) list of character codes and the corresponding characters are written to the current output stream. <pre class="prolog">put_chars( [] ). put_chars( [Char|Chars] ) :- put( Char ), put_chars( Chars ).</pre> ====get_chars( ?Chars )==== if <var>Chars</var> is a (possibly empty) list of character codes read from the current input stream. <pre class="prolog">get_chars( Input ) :- get0( Char ), ( Char > -1 -> Input = [Char|Chars], get_chars( Chars ) ; otherwise -> Input = [] ).</pre> The code is available as plain text [https://binding-time.co.uk/download/misc.txt here]. 91b8e3496de62ebaea68aff8a58d6f7fb2dd906a 196 180 2017-10-13T18:35:25Z John 2 Portability: Adding append/3 and length/2 which are not built into XSB. wikitext text/x-wiki The following predicates are used in the puzzle solutions. ==Higher-order Predicates== ====unique_solution( +Goal )==== holds when <var>Goal</var> has one ground solution. Operationally, <var>Goal</var> may produce several solutions, ("don't care" non-deterministically), but they must all be identical (<code>==</code>). <pre class="prolog">unique_solution( Goal ) :- findall( Goal, Goal, [Solution|Solutions] ), same_solution( Solutions, Solution ), Solution = Goal. same_solution( [], _Solution ). same_solution( [Solution0|Solutions], Solution ) :- Solution0 == Solution, same_solution( Solutions, Solution ).</pre> ====forall( +Enumerator, +Test )==== is true if <var>Enumerator</var> and <var>Test</var> are goals and <var>Test</var> holds everywhere that <var>Enumerator</var> does. NB: forall/2 does not instantiate arguments further. <pre class="prolog">forall( Enumerator, Test ) :- \+ (call(Enumerator), \+ call(Test)).</pre> ====count_solutions( +Goal, ?Count )==== is true if <var>Count</var> is the number of solutions for <var>Goal</var>. The solutions might not be distinct. <code>count_solutions/2</code> enumerates the possible solutions to <var>Goal</var> but does not instantiate <var>Goal</var>'s arguments further. <pre class="prolog"> count_solutions( Goal, Count ) :- findall( x, Goal, Xs ), length( Xs, Count ). </pre> ==Lists== ====member( ?Element, ?List )==== holds when <var>Element</var> is a member of <var>List</var>. <pre class="prolog">member( H, [H|_] ). member( H, [_|T] ) :- member( H, T ).</pre> ====select( ?Element, ?List0, ?List1 )==== is true if <var>List1</var> is equal to <var>List0</var> with <var>Element</var> removed. <pre class="prolog">select( H, [H|T], T ). select( Element, [H|T0], [H|T1] ) :- select( Element, T0, T1 ).</pre> ====memberchk( +Element, +List )==== succeeds (once) if <var>Element</var> is a member of <var>List</var>. <pre class="prolog">memberchk( Element, List ) :- member( Element, List ), !.</pre> ====append( ?Front, ?Back, ?List )==== succeeds if <var>Front</var>, <var>Back</var> and <var>List</var> are all lists and <var>List</var> is the concatenation of <var>Front</var> and <var>Back</var>. <pre class="prolog">append( [], L, L ). append( [H|T], L, [H|L1] ) :- append( T, L, L1 ). </pre> ====length( ?List, ?N )==== succeeds if <var>N</var> is the length of <var>List</var>. <pre class="prolog">length( List, N ) :- len1( List, 0, N ). len1( [], N, N ). len1( [_H|T], N0, N ) :- N1 is N0+1, len1( T, N1, N ). </pre> ==Arithmetic== ====between( +Lower, +Upper, ?Index )==== is true if <var>Lower</var> =< <var>Index</var> =< <var>Upper</var>. Two valid cases are possible: * <var>Index</var> is already instantiated to an integer, so the checks on order are applied (test). * <var>Index</var> is a logical variable: a series of alternative solutions may be generated as the monotonic sequence of values between <var>Lower</var> and <var>Upper</var> (non-deterministic generator). <pre class="prolog">between( Lower, Upper, Index ) :- integer( Lower ), integer( Upper ), Lower =< Upper, ( integer( Index ) -> % Case 1: "test" Index >= Lower, Index =< Upper ; var( Index ) -> % Case 2: "generate". generate_between( Lower, Upper, Index ) ). generate_between( Lower, Upper, Index ) :- ( Lower =:= Upper -> Index = Lower ; Index = Lower ; Next is Lower + 1, Next =< Upper, generate_between( Next, Upper, Index ) ).</pre> ====sum( +List, ?Sum )==== holds when the <var>List</var> of numbers sum to <var>Sum</var>. <pre class="prolog">sum( [H|T], Sum ) :- sum1( T, H, Sum ). sum1( [], Sum, Sum ). sum1( [H|T], Sum0, Sum ):- Sum1 is Sum0 + H, sum1( T, Sum1, Sum ).</pre> ==Character Input/Output== ====put_chars( +Chars )==== if <var>Chars</var> is a (possibly empty) list of character codes and the corresponding characters are written to the current output stream. <pre class="prolog">put_chars( [] ). put_chars( [Char|Chars] ) :- put( Char ), put_chars( Chars ).</pre> ====get_chars( ?Chars )==== if <var>Chars</var> is a (possibly empty) list of character codes read from the current input stream. <pre class="prolog">get_chars( Input ) :- get0( Char ), ( Char > -1 -> Input = [Char|Chars], get_chars( Chars ) ; otherwise -> Input = [] ).</pre> The code is available as plain text [https://binding-time.co.uk/download/misc.txt here]. c62d800cded4e4574236e0f162a0d3f299bd00c4 8 23 181 2017-01-10T19:11:39Z WikiSysop 1 Because I don't know how to remove the tabs themselves. css text/css /* CSS placed here will be applied to all skins */ /* JSF: "Discussion" disabled */ li#ca-talk {display: none} li#footer-places-disclaimer {display: none} 4d53638b21c0791578b1b9567c3f8b0715732015 192 181 2017-04-13T22:25:24Z WikiSysop 1 css text/css /* CSS placed here will be applied to all skins */ /* JSF: "Discussion" disabled */ li#ca-talk {display: none} li#footer-places-disclaimer {display: none} div.result {font-size: 90%} pre.prolog {font-size: 90%} 57cae5faf6b0f9f59ae70261122f43be43afe561 0 15 202 176 2018-01-13T20:28:09Z John 2 /* solve_murder( ?Murderer ) */ wikitext text/x-wiki __NOTOC__ ==Problem Statement== <blockquote><div>Problem posted to [https://groups.google.com/forum/#!msg/comp.lang.prolog/h2wy7VjCdEI/BzD3yB88K7oJ comp.lang.prolog] by Nimesh777@aol.com</div> M has been murdered. A, B and C are suspects. * A says he is innocent, B was M's friend but C hated M. * B says that he was out of town on the day of the murder, besides he didn't even know M. * C says he is innocent but he saw A &amp; B with M just before the murder. Assuming that all except possibly the murderer are telling the truth, solve the crime. </blockquote> ==Solution== <blockquote cite=""> When you have eliminated the impossible, whatever remains, however improbable, must be the truth. <cite>[http://www.gutenberg.org/ebooks/2097 Sir Arthur Conan Doyle - The Sign of the Four]</cite> </blockquote> ==== solve_murder( ?Murderer ) ==== Solving the crime means finding the <var>Murderer</var>'s identity, such that the <var>Murderer</var>'s statement is the only one that is inconsistent with the statements of the other suspects. <pre class="prolog">solve_murder( Murderer ) :- unique_solution( murderer( Murderer ) ).</pre> Firstly, the suspects' statements are formalized: <pre class="prolog">statement( a ) --> [innocent(a),friend(b,m),hates(c,m)]. statement( b ) --> [alibi(b),not_know(b,m)]. statement( c ) --> [innocent(c),with(c,m),with(b,m),with(a,m)]. statements( [] ) --> []. statements( [Witness|Witnesses] ) --> statement( Witness ), statements( Witnesses ).</pre> Then we define mutual-exclusivity between assertions. <pre class="prolog">mutually_exclusive( [friend(X,Y), hates(X,Y), not_know(X,Y)] ). mutually_exclusive( [innocent(X), guilty(X)] ). mutually_exclusive( [alibi(X), with(X,m)] ). mutually_exclusive( [alibi(X), with(m,X)] ). mutually_exclusive( [alibi(X), guilty(X)] ).</pre> The murderer is identified by showing that the statements of the other suspects (witnesses) are consistent with each other, and with the murderer being guilty. <pre class="prolog">murderer( Murderer ) :- Suspects = [a,b,c], select( Murderer, Suspects, Witnesses ), phrase( statements(Witnesses), Assertions ), consistent( [guilty(Murderer)|Assertions] ).</pre> A set of assertions is consistent if no inconsistency can be found between any member and the rest of the set. <pre class="prolog">consistent( Statements ) :- \+ inconsistent( Statements ).</pre> An assertion is inconsistent with a set of assertions if it is pairwise exclusive with a member of the set. <pre class="prolog">inconsistent( [Assertion|Assertions] ) :- mutually_exclusive( Exclusive ), select( Assertion, Exclusive, Inconsistent ), member( Inconsistency, Inconsistent ), member( Inconsistency, Assertions ). inconsistent( [_Assertion|Assertions] ) :- inconsistent( Assertions ).</pre> Load a small library of [[Puzzle Utilities]]. <pre class="prolog">:- ensure_loaded( misc ).</pre> The code is available as plain text [https://binding-time.co.uk/download/whodunit.txt here]. ==Result== <pre>?- solve_murder( Murderer ). Murderer = b</pre> 0de85292e6b0eed263d4b45f441d89c8cdc7b744 0 18 203 179 2018-01-13T20:31:09Z John 2 /* input_document( +File, ?XML ) */ wikitext text/x-wiki __NOTOC__ The following is a complete example to illustrate how the xml.pl module can be used. It exercises both the input and output parsing modes of <code>xml_parse/[2,3]</code>, and illustrates the use of <code>xml_subterm/2</code> to access the nodes of a &ldquo;document value model&rdquo;. It's written for Quintus Prolog, but should port to other Prologs easily. ====test( +QueryId )==== The <code>test/1</code> predicate is the entry-point of the program and executes a Prolog implementation of a Query from [http://www.w3.org/TR/xquery-use-cases/#xmp Use Case &ldquo;XMP&rdquo;: Experiences and Exemplars], in the W3C's XML Query Use Cases, which &ldquo;contains several example queries that illustrate requirements gathered from the database and document communities&rdquo;. <var>QueryId</var> is one of <code>q1</code>...<code>q12</code> selecting which of the 12 use cases is executed. The XML output is written to the file [QueryId].xml in the current directory. <code>xml_pp/1</code> is used to display the resulting &ldquo;document value model&rdquo; data-structures on the user output (stdout) stream. <pre class="prolog">test( Query ) :- xml_query( Query, ResultElement ), % Parse output XML into the Output chars xml_parse( Output, xml([], [ResultElement]) ), absolute_file_name( Query, [extensions(xml)], OutputFile ), % Write OutputFile from the Output list of chars tell( OutputFile ), put_chars( Output ), told, % Pretty print OutputXML write( 'Output XML' ), nl, xml_pp( xml([], [ResultElement]) ).</pre> ====xml_query( +QueryNo, ?OutputXML )==== when <var>OutputXML</var> is an XML Document Value Model produced by running an example, identified by <var>QueryNo</var>, taken from the XML Query &ldquo;XMP&rdquo; use case. ===Q1=== List books published by Addison-Wesley after 1991, including their year and title. <pre class="prolog">xml_query( q1, element(bib, [], Books) ) :- element_name( Title, title ), element_name( Publisher, publisher ), input_document( 'bib.xml', Bibliography ), findall( element(book, [year=Year], [Title]), ( xml_subterm( Bibliography, element(book, Attributes, Content) ), xml_subterm( Content, Publisher ), xml_subterm( Publisher, Text ), text_value( Text, "Addison-Wesley" ), member( year=Year, Attributes ), number_codes( YearNo, Year ), YearNo > 1991, xml_subterm( Content, Title ) ), Books ).</pre> ===Q2=== Create a flat list of all the title-author pairs, with each pair enclosed in a &ldquo;result&rdquo; element. <pre class="prolog">xml_query( q2, element(results, [], Results) ) :- element_name( Title, title ), element_name( Author, author ), element_name( Book, book ), input_document( 'bib.xml', Bibliography ), findall( element(result, [], [Title,Author]), ( xml_subterm( Bibliography, Book ), xml_subterm( Book, Title ), xml_subterm( Book, Author ) ), Results ).</pre> ===Q3=== For each book in the bibliography, list the title and authors, grouped inside a &ldquo;result&rdquo; element. <pre class="prolog">xml_query( q3, element(results, [], Results) ) :- element_name( Title, title ), element_name( Author, author ), element_name( Book, book ), input_document( 'bib.xml', Bibliography ), findall( element(result, [], [Title|Authors]), ( xml_subterm( Bibliography, Book ), xml_subterm( Book, Title ), findall( Author, xml_subterm(Book, Author), Authors ) ), Results ).</pre> ===Q4=== For each author in the bibliography, list the author's name and the titles of all books by that author, grouped inside a &ldquo;result&rdquo; element. <pre class="prolog">xml_query( q4, element(results, [], Results) ) :- element_name( Title, title ), element_name( Author, author ), element_name( Book, book ), input_document( 'bib.xml', Bibliography ), findall( Author, xml_subterm(Bibliography, Author), AuthorBag ), sort( AuthorBag, Authors ), findall( element(result, [], [Author|Titles]), ( member( Author, Authors ), findall( Title, ( xml_subterm( Bibliography, Book ), xml_subterm( Book, Author ), xml_subterm( Book, Title ) ), Titles ) ), Results ).</pre> ===Q5=== For each book found at both bn.com and amazon.com, list the title of the book and its price from each source. <pre class="prolog">xml_query( q5, element('books-with-prices', [], BooksWithPrices) ) :- element_name( Title, title ), element_name( Book, book ), element_name( Review, entry ), input_document( 'bib.xml', Bibliography ), input_document( 'reviews.xml', Reviews ), findall( element('book-with-prices', [], [ Title, element('price-bn',[], BNPrice ), element('price-amazon',[], AmazonPrice ) ] ), ( xml_subterm( Bibliography, Book ), xml_subterm( Book, Title ), xml_subterm( Reviews, Review ), xml_subterm( Review, Title ), xml_subterm( Book, element(price,_, BNPrice) ), xml_subterm( Review, element(price,_, AmazonPrice) ) ), BooksWithPrices ).</pre> ===Q6=== For each book that has at least one author, list the title and first two authors, and an empty &ldquo;et-al&rdquo; element if the book has additional authors. <pre class="prolog">xml_query( q6, element(bib, [], Results) ) :- element_name( Title, title ), element_name( Author, author ), element_name( Book, book ), input_document( 'bib.xml', Bibliography ), findall( element(book, [], [Title,FirstAuthor|Authors]), ( xml_subterm( Bibliography, Book ), xml_subterm( Book, Title ), findall( Author, xml_subterm(Book, Author), [FirstAuthor|Others] ), other_authors( Others, Authors ) ), Results ).</pre> ===Q7=== List the titles and years of all books published by Addison-Wesley after 1991, in alphabetic order. <pre class="prolog">xml_query( q7, element(bib, [], Books) ) :- element_name( Title, title ), element_name( Publisher, publisher ), input_document( 'bib.xml', Bibliography ), findall( Title-element(book, [year=Year], [Title]), ( xml_subterm( Bibliography, element(book, Attributes, Book) ), xml_subterm( Book, Publisher ), xml_subterm( Publisher, Text ), text_value( Text, "Addison-Wesley" ), member( year=Year, Attributes ), number_codes( YearNo, Year ), YearNo > 1991, xml_subterm( Book, Title ) ), TitleBooks ), keysort( TitleBooks, TitleBookSet ), range( TitleBookSet, Books ).</pre> ===Q8=== Find books in which the name of some element ends with the string &ldquo;or&rdquo; and the same element contains the string &ldquo;Suciu&rdquo; somewhere in its content. For each such book, return the title and the qualifying element. <pre class="prolog">xml_query( q8, element(bib, [], Books) ) :- element_name( Title, title ), element_name( Book, book ), element_name( QualifyingElement, QualifyingName ), append( "Suciu", _Back, Suffix ), input_document( 'bib.xml', Bibliography ), findall( element(book, [], [Title,QualifyingElement]), ( xml_subterm( Bibliography, Book ), xml_subterm( Book, QualifyingElement ), atom_codes( QualifyingName, QNChars ), append( _QNPrefix, "or", QNChars ), xml_subterm( QualifyingElement, TextItem ), text_value( TextItem, TextValue ), append( _Prefix, Suffix, TextValue ), xml_subterm( Book, Title ) ), Books ).</pre> ===Q9=== In the document &ldquo;books.xml&rdquo;, find all section or chapter titles that contain the word &ldquo;XML&rdquo;, regardless of the level of nesting. <pre class="prolog">xml_query( q9, element(results, [], Titles) ) :- element_name( Title, title ), append( "XML", _Back, Suffix ), input_document( 'books.xml', Books ), findall( Title, ( xml_subterm( Books, Title ), xml_subterm( Title, TextItem ), text_value( TextItem, TextValue ), append( _Prefix, Suffix, TextValue ) ), Titles ).</pre> ===Q10=== In the document &ldquo;prices.xml&rdquo;, find the minimum price for each book, in the form of a &ldquo;minprice&rdquo; element with the book title as its title attribute. <pre class="prolog">xml_query( q10, element(results, [], MinPrices) ) :- element_name( Title, title ), element_name( Price, price ), input_document( 'prices.xml', Prices ), findall( Title, xml_subterm(Prices, Title), TitleBag ), sort( TitleBag, TitleSet ), element_name( Book, book ), findall( element(minprice, [title=TitleString], [MinPrice]), ( member( Title, TitleSet ), xml_subterm( Title, TitleText ), text_value( TitleText, TitleString ), findall( PriceValue-Price, ( xml_subterm( Prices, Book ), xml_subterm( Book, Title ), xml_subterm( Book, Price ), xml_subterm( Price, Text ), text_value( Text, PriceChars ), number_codes( PriceValue, PriceChars ) ), PriceValues ), minimum( PriceValues, PriceValue-MinPrice ) ), MinPrices ).</pre> ===Q11=== For each book with an author, return the book with its title and authors. For each book with an editor, return a reference with the book title and the editor's affiliation. <pre class="prolog">xml_query( q11, element(bib, [], Results) ) :- element_name( Title, title ), element_name( Author, author ), element_name( Book, book ), element_name( Editor, editor ), element_name( Affiliation, affiliation ), input_document( 'bib.xml', Bibliography ), findall( element(book, [], [Title,FirstAuthor|Authors]), ( xml_subterm( Bibliography, Book ), xml_subterm( Book, Title ), findall( Author, xml_subterm(Book, Author), [FirstAuthor|Authors] ) ), Books ), findall( element(reference, [], [Title,Affiliation]), ( xml_subterm( Bibliography, Book ), xml_subterm( Book, Title ), xml_subterm( Book, Editor ), xml_subterm( Editor, Affiliation ) ), References ), append( Books, References, Results ).</pre> ===Q12=== Find pairs of books that have different titles but the same set of authors (possibly in a different order). <pre class="prolog">xml_query( q12, element(bib, [], Pairs) ) :- element_name( Author, author ), element_name( Book1, book ), element_name( Book2, book ), element_name( Title1, title ), element_name( Title2, title ), input_document( 'bib.xml', Bibliography ), findall( element('book-pair', [], [Title1,Title2]), ( xml_subterm( Bibliography, Book1 ), findall( Author, xml_subterm(Book1, Author), AuthorBag1 ), sort( AuthorBag1, AuthorSet ), xml_subterm( Bibliography, Book2 ), Book2 @< Book1, findall( Author, xml_subterm(Book2, Author), AuthorBag2 ), sort( AuthorBag2, AuthorSet ), xml_subterm( Book1, Title1 ), xml_subterm( Book2, Title2 ) ), Pairs ).</pre> == Auxiliary Predicates == <pre class="prolog">other_authors( [], [] ). other_authors( [Author|Authors], [Author|EtAl] ) :- et_al( Authors, EtAl ). et_al( [], [] ). et_al( [_|_], [element('et-al',[],[])] ). text_value( [pcdata(Text)], Text ). text_value( [cdata(Text)], Text ). element_name( element(Name, _Attributes, _Content), Name ).</pre> ====range( +Pairs, ?Range )==== when <var>Pairs</var> is a list of key-datum pairs and <var>Range</var> is the list of data. <pre class="prolog">range( [], [] ). range( [_Key-Datum|Pairs], [Datum|Data] ) :- range( Pairs, Data ).</pre> ====minimum( +List, ?Min )==== is true if <var>Min</var> is the least member of <var>List</var> in the standard order. <pre class="prolog">minimum( [H|T], Min ):- minimum1( T, H, Min ). minimum1( [], Min, Min ). minimum1( [H|T], Min0, Min ) :- compare( Relation, H, Min0 ), minimum2( Relation, H, Min0, T, Min ). minimum2( '=', Min0, Min0, T, Min ) :- minimum1( T, Min0, Min ). minimum2( '<', Min0, _Min1, T, Min ) :- minimum1( T, Min0, Min ). minimum2( '>', _Min0, Min1, T, Min ) :- minimum1( T, Min1, Min ).</pre> ====input_document( +File, ?XML )==== reads <var>File</var> and parses the input into the &ldquo;Document Value Model&rdquo; <var>XML</var>. <pre class="prolog">input_document( File, XML ) :- % Read InputFile as a list of chars see( File ), get_chars( Input ), seen, % Parse the Input chars into the term XML xml_parse( Input, XML ).</pre> Load the [[XML Module]]. <pre class="prolog">:- use_module( xml ).</pre> Load a small library of [[Puzzle Utilities]]. <pre class="prolog"> :- ensure_loaded( misc ). </pre> Download a 5Kb tar.gz format [https://binding-time.co.uk/download/xml_example.tar.gz file containing this program with input and output data]. 1d56d8c2b8ff55b27e3fb7195e64b3ceb064ba5c 0 17 204 187 2018-01-13T20:31:58Z John 2 /* Download */ wikitext text/x-wiki __NOTOC__ == Terms and Conditions == This program is offered free of charge as unsupported source code. You may use it, copy it, distribute it, modify it or sell it without restriction. I hope that it will be useful to you, but it is provided &quot;as is&quot; without any warranty express or implied, including but not limited to the warranty of non-infringement and the implied warranties of merchantability and fitness for a particular purpose. == Download == <pre>Current Version: XML Module 3.7 released 2014/07/09 Windows application plxml 4.0 released 2016/12/27 </pre> [https://binding-time.co.uk/download/xmlpl.tar.gz Download the source code] in tar.gz format (21KB) [https://binding-time.co.uk/download/xmlpl.zip Download the source code and Windows application] as a ZIP file (431KB). ''Substantial XML input performance improvement in version 4.0''. == Extracting the files == Unzip the files to create a folder structure as follows: <pre>+---bin | | plxml.exe : Application | | libpl.dll : Quintus Prolog support DLL | | libqp.dll : &quot; &quot; &quot; &quot; | | qpconsole.dll : &quot; &quot; &quot; &quot; | | qpeng.dll : &quot; &quot; &quot; &quot; | +---source | xml.pl : Quintus Prolog module wrapper | xml.iso.pl : ISO Prolog module wrapper | xml.lpa.pl : LPA Prolog wrapper | xml_driver.pl : Driver | xml_acquisition.pl : Chars -&gt; Document parsing | xml_generation.pl : Document -&gt; Chars parsing | xml_diagnosis.pl : Document -&gt; Chars parsing exception | xml_pp.pl : Document pretty-printing | xml_utilities.pl : Shared code</pre> == The Source Code (xml.pl) == xml is intended to be a modular module: it should be easy to build a program that can output XML, but not read it, or vice versa. Similarly, you may be happy to dispense with diagnosis once you are sure that your code will only try to make valid calls to xml_parse/2. It is intended that the code should be very portable too. Clearly, some small changes will be needed between platforms, but these should be limited to the top-level wrapper file which contains the potentially non-portable code. It is suggested that you name the wrapper file you need as xml.pl == Using plxml.exe == The application and the DLLs should reside in the same directory, unless you have a good reason to do something different. The application is invoked with two file names as operands, i.e. plxml [-(c|p|a)*] INPUT OUTPUT If INPUT contains a Prolog xml/2 clause, OUTPUT is written as the corresponding XML. If INPUT contains a Prolog malformed/2 clause, OUTPUT is written as the corresponding XML with the unparsed/1 and out_of_context/1 terms written as CDATA. If INPUT is an XML file, OUTPUT is written as a Prolog xml/2 or malformed/2 clause. INPUT and/or OUTPUT may be &quot;-&quot; indicating stdin/stdout respectively. ; The -a option : allows unescaped &amp; (ampersand) characters to occur in PCDATA; ; The -p option : preserves whitespace; ; The -c option : causes prefixes to be removed from attribute names if the explicitly denoted namespace is the same as that of the containing tag (XML input only); Plxml's Prolog output is compatible with [http://www.lpa.co.uk/ LPA Prolog]. Specifically, strings containing ~ (tilde) characters are output as lists of character codes. === Using plxml as a development tool === A common use of xml.pl is to populate template XML documents with answers from a Prolog application. A nice approach is to design a prototype document and then translate this into an xml/2 term with plxml. For example, a prototype HTML page could be produced with a WYSIWYG XHTML editor. Alternatively, if your editor produces plain HTML, you can use plxml in combination with [http://www.htacg.org/ HTML Tidy] e.g. tidy -asxhtml -ascii [HTMLFile] | plxml - [PLFile] Similarly, during prototyping/early development it may be convenient to use plxml as the interface, rather than integrating xml.pl. === Using plxml to repair XML === plxml can sometimes repair broken XML: plxml -ac [Broken XML] - | plxml - [Fixed XML] === Character Encoding === By default, plxml can accept input encoded as UTF-8 or UTF-16, which encompasses plain 7-bit ASCII. The iso-8859-1, iso-8859-2, iso-8859-15 and windows-1252 8-bit encodings are supported, but they must be identified correctly in the signature of the XML document. xml.pl, (and therefore plxml), output a plain ASCII encoding with the following properties: * In all character data, the characters &amp; &lt; and &gt; are encoded as &amp;amp; &amp;lt; and &amp;gt; respectively. * In non-parsed character data, such as ''Attribute Values'', the characters &quot; and ' are encoded as &amp;quot; and &amp;apos; respectively. * Any character codes &gt; 127 are output as decimal character entities e.g. 160 as &amp;#160;. * Only [http://www.w3.org/TR/2000/REC-xml-20001006#NT-Char character codes allowed by the XML specification] are encoded by xml_parse/[2,3]. f82a887399c889f982c7768edd005861dafda6c1 225 204 2018-06-20T10:52:38Z John 2 Updated link to XML specification. wikitext text/x-wiki __NOTOC__ == Terms and Conditions == This program is offered free of charge as unsupported source code. You may use it, copy it, distribute it, modify it or sell it without restriction. I hope that it will be useful to you, but it is provided &quot;as is&quot; without any warranty express or implied, including but not limited to the warranty of non-infringement and the implied warranties of merchantability and fitness for a particular purpose. == Download == <pre>Current Version: XML Module 3.7 released 2014/07/09 Windows application plxml 4.0 released 2016/12/27 </pre> [https://binding-time.co.uk/download/xmlpl.tar.gz Download the source code] in tar.gz format (21KB) [https://binding-time.co.uk/download/xmlpl.zip Download the source code and Windows application] as a ZIP file (431KB). ''Substantial XML input performance improvement in version 4.0''. == Extracting the files == Unzip the files to create a folder structure as follows: <pre>+---bin | | plxml.exe : Application | | libpl.dll : Quintus Prolog support DLL | | libqp.dll : &quot; &quot; &quot; &quot; | | qpconsole.dll : &quot; &quot; &quot; &quot; | | qpeng.dll : &quot; &quot; &quot; &quot; | +---source | xml.pl : Quintus Prolog module wrapper | xml.iso.pl : ISO Prolog module wrapper | xml.lpa.pl : LPA Prolog wrapper | xml_driver.pl : Driver | xml_acquisition.pl : Chars -&gt; Document parsing | xml_generation.pl : Document -&gt; Chars parsing | xml_diagnosis.pl : Document -&gt; Chars parsing exception | xml_pp.pl : Document pretty-printing | xml_utilities.pl : Shared code</pre> == The Source Code (xml.pl) == xml is intended to be a modular module: it should be easy to build a program that can output XML, but not read it, or vice versa. Similarly, you may be happy to dispense with diagnosis once you are sure that your code will only try to make valid calls to xml_parse/2. It is intended that the code should be very portable too. Clearly, some small changes will be needed between platforms, but these should be limited to the top-level wrapper file which contains the potentially non-portable code. It is suggested that you name the wrapper file you need as xml.pl == Using plxml.exe == The application and the DLLs should reside in the same directory, unless you have a good reason to do something different. The application is invoked with two file names as operands, i.e. plxml [-(c|p|a)*] INPUT OUTPUT If INPUT contains a Prolog xml/2 clause, OUTPUT is written as the corresponding XML. If INPUT contains a Prolog malformed/2 clause, OUTPUT is written as the corresponding XML with the unparsed/1 and out_of_context/1 terms written as CDATA. If INPUT is an XML file, OUTPUT is written as a Prolog xml/2 or malformed/2 clause. INPUT and/or OUTPUT may be &quot;-&quot; indicating stdin/stdout respectively. ; The -a option : allows unescaped &amp; (ampersand) characters to occur in PCDATA; ; The -p option : preserves whitespace; ; The -c option : causes prefixes to be removed from attribute names if the explicitly denoted namespace is the same as that of the containing tag (XML input only); Plxml's Prolog output is compatible with [http://www.lpa.co.uk/ LPA Prolog]. Specifically, strings containing ~ (tilde) characters are output as lists of character codes. === Using plxml as a development tool === A common use of xml.pl is to populate template XML documents with answers from a Prolog application. A nice approach is to design a prototype document and then translate this into an xml/2 term with plxml. For example, a prototype HTML page could be produced with a WYSIWYG XHTML editor. Alternatively, if your editor produces plain HTML, you can use plxml in combination with [http://www.htacg.org/ HTML Tidy] e.g. tidy -asxhtml -ascii [HTMLFile] | plxml - [PLFile] Similarly, during prototyping/early development it may be convenient to use plxml as the interface, rather than integrating xml.pl. === Using plxml to repair XML === plxml can sometimes repair broken XML: plxml -ac [Broken XML] - | plxml - [Fixed XML] === Character Encoding === By default, plxml can accept input encoded as UTF-8 or UTF-16, which encompasses plain 7-bit ASCII. The iso-8859-1, iso-8859-2, iso-8859-15 and windows-1252 8-bit encodings are supported, but they must be identified correctly in the signature of the XML document. xml.pl, (and therefore plxml), output a plain ASCII encoding with the following properties: * In all character data, the characters &amp; &lt; and &gt; are encoded as &amp;amp; &amp;lt; and &amp;gt; respectively. * In non-parsed character data, such as ''Attribute Values'', the characters &quot; and ' are encoded as &amp;quot; and &amp;apos; respectively. * Any character codes &gt; 127 are output as decimal character entities e.g. 160 as &amp;#160;. * Only [https://www.w3.org/TR/xml/#NT-Char character codes allowed by the XML specification] are encoded by xml_parse/[2,3]. d52e3ca8fd0c3decde43e593c0c78e3a4e2d7b74 239 225 2020-03-26T23:19:40Z John 2 plxml v5.0 wikitext text/x-wiki __NOTOC__ == Terms and Conditions == This program is offered free of charge as unsupported source code. You may use it, copy it, distribute it, modify it or sell it without restriction. I hope that it will be useful to you, but it is provided &quot;as is&quot; without any warranty express or implied, including but not limited to the warranty of non-infringement and the implied warranties of merchantability and fitness for a particular purpose. == Download == <pre>Current Version: XML Module 3.7 released 2014/07/09 Windows application plxml 5.0 released 2020/03/27 </pre> [https://binding-time.co.uk/download/xmlpl.tar.gz Download the source code] in tar.gz format (21KB) [https://binding-time.co.uk/download/xmlpl.zip Download the source code and Windows application] as a ZIP file (436KB). ''UTF-8 XML output &ndash; supporting non-ASCII Unicode characters in comments and CDATA sections.'' == Extracting the files == Unzip the files to create a folder structure as follows: <pre>+---bin | | plxml.exe : Application | | libpl.dll : Quintus Prolog support DLL | | libqp.dll : &quot; &quot; &quot; &quot; | | qpconsole.dll : &quot; &quot; &quot; &quot; | | qpeng.dll : &quot; &quot; &quot; &quot; | +---source | xml.pl : Quintus Prolog module wrapper | xml.iso.pl : ISO Prolog module wrapper | xml.lpa.pl : LPA Prolog wrapper | xml_driver.pl : Driver | xml_acquisition.pl : Chars -&gt; Document parsing | xml_generation.pl : Document -&gt; Chars parsing | xml_diagnosis.pl : Document -&gt; Chars parsing exception | xml_pp.pl : Document pretty-printing | xml_utilities.pl : Shared code</pre> == The Source Code (xml.pl) == xml is intended to be a modular module: it should be easy to build a program that can output XML, but not read it, or vice versa. Similarly, you may be happy to dispense with diagnosis once you are sure that your code will only try to make valid calls to xml_parse/2. It is intended that the code should be very portable too. Clearly, some small changes will be needed between platforms, but these should be limited to the top-level wrapper file which contains the potentially non-portable code. It is suggested that you name the wrapper file you need as xml.pl == Using plxml.exe == The application and the DLLs should reside in the same directory, unless you have a good reason to do something different. The application is invoked with two file names as operands, i.e. plxml [-(c|p|a)*] INPUT OUTPUT If INPUT contains a Prolog xml/2 clause, OUTPUT is written as the corresponding XML. If INPUT contains a Prolog malformed/2 clause, OUTPUT is written as the corresponding XML with the unparsed/1 and out_of_context/1 terms written as CDATA. If INPUT is an XML file, OUTPUT is written as a Prolog xml/2 or malformed/2 clause. INPUT and/or OUTPUT may be &quot;-&quot; indicating stdin/stdout respectively. ; The -a option : allows unescaped &amp; (ampersand) characters to occur in PCDATA; ; The -p option : preserves whitespace; ; The -c option : causes prefixes to be removed from attribute names if the explicitly denoted namespace is the same as that of the containing tag (XML input only); Plxml's Prolog output is compatible with [http://www.lpa.co.uk/ LPA Prolog]. Specifically, strings containing ~ (tilde) characters are output as lists of character codes. === Using plxml as a development tool === A common use of xml.pl is to populate template XML documents with answers from a Prolog application. A nice approach is to design a prototype document and then translate this into an xml/2 term with plxml. For example, a prototype HTML page could be produced with a WYSIWYG XHTML editor. Alternatively, if your editor produces plain HTML, you can use plxml in combination with [http://www.htacg.org/ HTML Tidy] e.g. tidy -asxhtml -ascii [HTMLFile] | plxml - [PLFile] Similarly, during prototyping/early development it may be convenient to use plxml as the interface, rather than integrating xml.pl. === Using plxml to repair XML === plxml can sometimes repair broken XML: plxml -ac [Broken XML] - | plxml - [Fixed XML] === Character Encoding === By default, plxml can accept input encoded as UTF-8 or UTF-16, which encompasses plain 7-bit ASCII. The iso-8859-1, iso-8859-2, iso-8859-15 and windows-1252 8-bit encodings are supported, but they must be identified correctly in the signature of the XML document. With the exception of comments and CDATA sections, xml.pl and therefore plxml, output a plain ASCII encoding with the following properties: * In all character data, the characters &amp; &lt; and &gt; are encoded as &amp;amp; &amp;lt; and &amp;gt; respectively. * In non-parsed character data, such as ''Attribute Values'', the characters &quot; and ' are encoded as &amp;quot; and &amp;apos; respectively. * Any character codes &gt; 127 are output as decimal character entities e.g. 160 as &amp;#160;. Only [https://www.w3.org/TR/xml/#NT-Char character codes allowed by the XML specification] are encoded by xml_parse/[2,3]. From version 5.0, plxml XML output is encoded as UTF-8. 198362b6e6f5c305a6923d929af92edea0dc0c53 240 239 2020-03-26T23:22:11Z John 2 wikitext text/x-wiki __NOTOC__ == Terms and Conditions == This program is offered free of charge as unsupported source code. You may use it, copy it, distribute it, modify it or sell it without restriction. I hope that it will be useful to you, but it is provided &quot;as is&quot; without any warranty express or implied, including but not limited to the warranty of non-infringement and the implied warranties of merchantability and fitness for a particular purpose. == Download == <pre>Current Version: XML Module 3.7 released 2014/07/09 Windows application plxml 5.0 released 2020/03/27 </pre> [https://binding-time.co.uk/download/xmlpl.tar.gz Download the source code] in tar.gz format (21KB) [https://binding-time.co.uk/download/xmlpl.zip Download the source code and Windows application] as a ZIP file (436KB). ''UTF-8 XML output &ndash; supporting non-ASCII Unicode characters in comments and CDATA sections.'' == Extracting the files == Unzip the files to create a folder structure as follows: <pre>+---bin | | plxml.exe : Application | | libpl.dll : Quintus Prolog support DLL | | libqp.dll : &quot; &quot; &quot; &quot; | | qpconsole.dll : &quot; &quot; &quot; &quot; | | qpeng.dll : &quot; &quot; &quot; &quot; | +---source | xml.pl : Quintus Prolog module wrapper | xml.iso.pl : ISO Prolog module wrapper | xml.lpa.pl : LPA Prolog wrapper | xml_driver.pl : Driver | xml_acquisition.pl : Chars -&gt; Document parsing | xml_generation.pl : Document -&gt; Chars parsing | xml_diagnosis.pl : Document -&gt; Chars parsing exception | xml_pp.pl : Document pretty-printing | xml_utilities.pl : Shared code</pre> == The Source Code (xml.pl) == xml is intended to be a modular module: it should be easy to build a program that can output XML, but not read it, or vice versa. Similarly, you may be happy to dispense with diagnosis once you are sure that your code will only try to make valid calls to xml_parse/2. It is intended that the code should be very portable too. Clearly, some small changes will be needed between platforms, but these should be limited to the top-level wrapper file which contains the potentially non-portable code. It is suggested that you name the wrapper file you need as xml.pl == Using plxml.exe == The application and the DLLs should reside in the same directory, unless you have a good reason to do something different. The application is invoked with two file names as operands, i.e. plxml [-(c|p|a)*] INPUT OUTPUT If INPUT contains a Prolog xml/2 clause, OUTPUT is written as the corresponding XML. If INPUT contains a Prolog malformed/2 clause, OUTPUT is written as the corresponding XML with the unparsed/1 and out_of_context/1 terms written as CDATA. If INPUT is an XML file, OUTPUT is written as a Prolog xml/2 or malformed/2 clause. INPUT and/or OUTPUT may be &quot;-&quot; indicating stdin/stdout respectively. ; The -a option : allows unescaped &amp; (ampersand) characters to occur in PCDATA; ; The -p option : preserves whitespace; ; The -c option : causes prefixes to be removed from attribute names if the explicitly denoted namespace is the same as that of the containing tag (XML input only); Plxml's Prolog output is compatible with [http://www.lpa.co.uk/ LPA Prolog]. Specifically, strings containing ~ (tilde) characters are output as lists of character codes. === Using plxml as a development tool === A common use of xml.pl is to populate template XML documents with answers from a Prolog application. A nice approach is to design a prototype document and then translate this into an xml/2 term with plxml. For example, a prototype HTML page could be produced with a WYSIWYG XHTML editor. Alternatively, if your editor produces plain HTML, you can use plxml in combination with [http://www.htacg.org/ HTML Tidy] e.g. tidy -asxhtml -ascii [HTMLFile] | plxml - [PLFile] Similarly, during prototyping/early development it may be convenient to use plxml as the interface, rather than integrating xml.pl. === Using plxml to repair XML === plxml can sometimes repair broken XML: plxml -ac [Broken XML] - | plxml - [Fixed XML] === Character Encoding === By default, plxml can accept input encoded as UTF-8 or UTF-16, which encompasses plain 7-bit ASCII. The iso-8859-1, iso-8859-2, iso-8859-15 and windows-1252 8-bit encodings are supported, but they must be identified correctly in the signature of the XML document. With the exception of comments and CDATA sections, xml.pl and plxml output a plain ASCII encoding with the following properties: * In all character data, the characters &amp; &lt; and &gt; are encoded as &amp;amp; &amp;lt; and &amp;gt; respectively. * In non-parsed character data, such as ''Attribute Values'', the characters &quot; and ' are encoded as &amp;quot; and &amp;apos; respectively. * Any character codes &gt; 127 are output as decimal character entities e.g. 160 as &amp;#160;. Only [https://www.w3.org/TR/xml/#NT-Char character codes allowed by the XML specification] are encoded by xml_parse/[2,3]. From version 5.0, plxml XML output is encoded as UTF-8. 3e3387f340cce3b0dfc75cfa55b6e8d7d9d355cd 244 240 2020-05-11T22:39:20Z John 2 /* Using plxml.exe */ wikitext text/x-wiki __NOTOC__ == Terms and Conditions == This program is offered free of charge as unsupported source code. You may use it, copy it, distribute it, modify it or sell it without restriction. I hope that it will be useful to you, but it is provided &quot;as is&quot; without any warranty express or implied, including but not limited to the warranty of non-infringement and the implied warranties of merchantability and fitness for a particular purpose. == Download == <pre>Current Version: XML Module 3.7 released 2014/07/09 Windows application plxml 5.0 released 2020/03/27 </pre> [https://binding-time.co.uk/download/xmlpl.tar.gz Download the source code] in tar.gz format (21KB) [https://binding-time.co.uk/download/xmlpl.zip Download the source code and Windows application] as a ZIP file (436KB). ''UTF-8 XML output &ndash; supporting non-ASCII Unicode characters in comments and CDATA sections.'' == Extracting the files == Unzip the files to create a folder structure as follows: <pre>+---bin | | plxml.exe : Application | | libpl.dll : Quintus Prolog support DLL | | libqp.dll : &quot; &quot; &quot; &quot; | | qpconsole.dll : &quot; &quot; &quot; &quot; | | qpeng.dll : &quot; &quot; &quot; &quot; | +---source | xml.pl : Quintus Prolog module wrapper | xml.iso.pl : ISO Prolog module wrapper | xml.lpa.pl : LPA Prolog wrapper | xml_driver.pl : Driver | xml_acquisition.pl : Chars -&gt; Document parsing | xml_generation.pl : Document -&gt; Chars parsing | xml_diagnosis.pl : Document -&gt; Chars parsing exception | xml_pp.pl : Document pretty-printing | xml_utilities.pl : Shared code</pre> == The Source Code (xml.pl) == xml is intended to be a modular module: it should be easy to build a program that can output XML, but not read it, or vice versa. Similarly, you may be happy to dispense with diagnosis once you are sure that your code will only try to make valid calls to xml_parse/2. It is intended that the code should be very portable too. Clearly, some small changes will be needed between platforms, but these should be limited to the top-level wrapper file which contains the potentially non-portable code. It is suggested that you name the wrapper file you need as xml.pl == Using plxml.exe == The application and the DLLs should reside in the same directory, unless you have a good reason to do something different. The application is invoked with two file names as operands, i.e. plxml [-(c|p|a)*] INPUT OUTPUT If INPUT contains a Prolog xml/2 clause, OUTPUT is written as the corresponding XML. If INPUT contains a Prolog malformed/2 clause, OUTPUT is written as the corresponding XML with the unparsed/1 and out_of_context/1 terms written as CDATA. If INPUT is an XML file, OUTPUT is written as a Prolog xml/2 or malformed/2 clause. INPUT and/or OUTPUT may be &quot;-&quot; indicating stdin/stdout respectively. ; The -a option : allows unescaped &amp; (ampersand) characters to occur in PCDATA; ; The -p option : preserves whitespace; ; The -c option : causes prefixes to be removed from attribute names if the explicitly denoted namespace is the same as that of the containing tag (XML input only); Plxml's Prolog output is compatible with [https://www.lpa.co.uk/ LPA Prolog]. Specifically, strings containing ~ (tilde) characters are output as lists of character codes. === Using plxml as a development tool === A common use of xml.pl is to populate template XML documents with answers from a Prolog application. A nice approach is to design a prototype document and then translate this into an xml/2 term with plxml. For example, a prototype HTML page could be produced with a WYSIWYG XHTML editor. Alternatively, if your editor produces plain HTML, you can use plxml in combination with [http://www.htacg.org/ HTML Tidy] e.g. tidy -asxhtml -ascii [HTMLFile] | plxml - [PLFile] Similarly, during prototyping/early development it may be convenient to use plxml as the interface, rather than integrating xml.pl. === Using plxml to repair XML === plxml can sometimes repair broken XML: plxml -ac [Broken XML] - | plxml - [Fixed XML] === Character Encoding === By default, plxml can accept input encoded as UTF-8 or UTF-16, which encompasses plain 7-bit ASCII. The iso-8859-1, iso-8859-2, iso-8859-15 and windows-1252 8-bit encodings are supported, but they must be identified correctly in the signature of the XML document. With the exception of comments and CDATA sections, xml.pl and plxml output a plain ASCII encoding with the following properties: * In all character data, the characters &amp; &lt; and &gt; are encoded as &amp;amp; &amp;lt; and &amp;gt; respectively. * In non-parsed character data, such as ''Attribute Values'', the characters &quot; and ' are encoded as &amp;quot; and &amp;apos; respectively. * Any character codes &gt; 127 are output as decimal character entities e.g. 160 as &amp;#160;. Only [https://www.w3.org/TR/xml/#NT-Char character codes allowed by the XML specification] are encoded by xml_parse/[2,3]. From version 5.0, plxml XML output is encoded as UTF-8. f66cad1fd8b496d6cedd04e0dfa3e869c8df4a6a 0 20 205 197 2018-01-13T20:34:04Z John 2 /* Pillow 1.0 */ wikitext text/x-wiki == Porting PiLLoW to Quintus Prolog 3.X == The [http://cliplab.org/miscdocs/pillow/pillow.html PiLLoW] library provides predicates for developing HTTP client and server applications. For client applications, it provides mechanisms to retrieve HTML files and to parse HTML into useful Prolog terms. For server applications, it provides a predicate to access CGI query parameters, so that a Prolog application can be used to handle form input directly i.e. without additional scripting. Additionally, HTML parsing supports the reverse translation of terms into HTML, so that forms can be generated. ==PiLLoW 1.1== If you want to port [http://cliplab.org/miscdocs/pillow/pillow.html PiLLoW 1.1] to [http://quintus.sics.se/ Quintus Prolog], the following notes may be of use. ===http_transaction/5=== must be rewritten to use the Quintus tcp and socketio libraries. ====http_transaction(+Host, +Port, +Request, +Timeout, -Response)==== Sends an HTTP <var>Request</var> to an HTTP server <var>Host</var>:<var>Port</var> and returns the resulting message in <var>Response</var>. <var>Timeout</var> defines the maximum number of seconds to wait for a response. <pre class="prolog"> :- use_module(library(tcp)). :- use_module(library(socketio)). :- use_module(library(date), [now/1]). http_transaction( Host, Port, Request, Timeout, Response ) :- tcp:connect( Host, Port, Socket ), Socket >= 0, % Fail if connect error socket_io_open_output( Socket, Ocode ), stream_code( OStream, Ocode ), write_string( OStream, Request ), close( OStream ), socket_io_open_input( Socket, Icode ), stream_code( IStream, Icode ), now( Now ), http_transaction1( Now, Socket, IStream, Timeout, Response ), close( IStream ), tcp:tcp_shutdown( Socket, _Status ), Response \== timeout. http_transaction1( Now, Socket, IStream, Timeout, Response ) :- tcp:tcp_select( 0, Timeout, FD, Status ), http_transaction2( Status, Now, Socket, FD, IStream, Timeout, Response ). http_transaction2( 1, Then, Socket, FD, IStream, Timeout, Response ) :- ( Socket == FD -> stream_to_string( IStream, Response ) ; otherwise -> now( Now ), Elapsed is Now - Then, ( Elapsed < Timeout -> Timeout1 is Timeout - Elapsed, http_transaction1( Now, Socket, IStream, Timeout1, Response ) ; otherwise -> Response = timeout ) ). http_transaction2( 0, _Then, _Socket, _FD, _IStream, _Timeout, timeout ). http_transaction2( -1, _Then, Socket, _FD, IStream, Timeout, _Response ) :- raise_exception( socket_error(Socket, IStream, Timeout) ). getenvstr( Var, Chars ) :- environ( Var, Atom ), atom_chars( Atom, Chars ). :- use_module( library(environ), [environ/2] ). </pre> The ISO Prolog predicates used in PiLLoW can be mapped to equivalent Quintus built-in predicates. <pre class="prolog">flush_output :- ttyflush. atom_codes( Atom, Codes ) :- atom_chars( Atom, Codes ). catch( Goal, Error, Action ) :- on_exception( Error, Goal, Action ). get_code( Code ) :- get0( Code ). get_code( Stream, Code ) :- get0( Stream, Code ). include( File ) :- ensure_loaded( File ). number_codes( Number, Codes ) :- number_chars( Number, Codes ). put_code( Code ) :- put( Code ).</pre> Similarly, some library predicates are not defined/defined differently in Quintus: <pre class="prolog">atom_concat( A, B, AB ) :- name( A, AS ), name( B, BS ), append( AS, BS, ABS ), atom_chars( AB, ABS ). getenv( Var, QueryString ) :- environ( Var, QueryString ). :- use_module( library(environ), [environ/2] ).</pre> ==Pillow 1.0== I have ported PiLLoW 1.0 to use the [https://quintus.sics.se/ Quintus Prolog] 3.X libraries, and made it available as a [https://binding-time.co.uk/download/pillow.zip 260Kb Zip file]. It is offered here as free, '''unsupported''' source code, for which the author accepts no liability whatsoever. '''''Note:''''' The parsing of &quot;multipart&quot; form data on win32 can produce errors, when binary files are submitted, e.g. sending image files as part of the form input. This is because the default for &quot;stdin&quot; on win32 is &quot;text&quot;. 24ef4abc510cc78b680949ad729461c38bed3e90 0 8 206 194 2018-01-13T20:35:25Z John 2 /* Utility Predicates */ wikitext text/x-wiki __NOTOC__ This classic AI problem is described in ''Artificial Intelligence'' as follows: <blockquote> &ldquo;You are given two jugs, a 4-gallon one and a 3-gallon one. Neither has any measuring markers on it. There is a tap that can be used to fill the jugs with water. How can you get exactly 2 gallons of water into the 4-gallon jug?&rdquo;. <cite>[https://www.amazon.co.uk/Artificial-Intelligence-Elaine-Rich/dp/0070522634/276-9442056-6625664?tag=bindingtimeli-21 E. Rich & K. Knight, Artificial Intelligence, 2nd edition, McGraw-Hill, 1991]</cite> </blockquote> This program implements an environmentally responsible solution to the ''water jugs'' problem. Rather than filling and spilling from an infinite water resource, we conserve a finite initial charge with a third jug: (reservoir). This approach is simpler than the traditional method because there are only two actions. It is more flexible than the traditional method because it can solve problems that are constrained by a limited supply from the reservoir. To simulate the infinite version, we use a filled reservoir with a capacity greater than the combined capacities of the jugs so that the reservoir can never be emptied. <blockquote> &ldquo;Perfection is achieved not when there is nothing more to add, but when there is nothing more to take away.&rdquo; <cite>[https://en.wikiquote.org/wiki/Antoine_de_Saint_Exup%C3%A9ry Antoine de Saint-Exup&#233;ry]</cite> </blockquote> ==Solution== ====water_jugs==== is the entry point. The solution is derived by a simple, breadth-first, state-space search, and translated into a readable format by a DCG. <pre class="prolog">water_jugs :- SmallCapacity = 3, LargeCapacity = 4, Reservoir is SmallCapacity + LargeCapacity + 1, volume( small, Capacities, SmallCapacity ), volume( large, Capacities, LargeCapacity ), volume( reservoir, Capacities, Reservoir ), volume( small, Start, 0 ), volume( large, Start, 0 ), volume( reservoir, Start, Reservoir ), volume( large, End, 2 ), water_jugs_solution( Start, Capacities, End, Solution ), phrase( narrative(Solution, Capacities, End), Chars ), put_chars( Chars ).</pre> ====water_jugs_solution( +Start, +Capacities, +End, ?Solution )==== holds when <var>Solution</var> is the terminal state in a state-space search that begins with an initial state, in which the water-jugs have <var>Capacities</var> and contain the <var>Start</var> volumes, and ends when the water-jugs contain the <var>End</var> volumes. <pre class="prolog"> water_jugs_solution( Start, Capacities, End, Solution ) :- solve_jugs( [start(Start)], Capacities, [], End, Solution ). </pre> ====solve_jugs( +Nodes, +Capacities, +Visited, +End, ?Solution )==== holds when <var>Solution</var> is the terminal node in a state-space search, beginning with a first open node in <var>Nodes</var>, and terminating when the water-jugs contain the <var>End</var> volumes. <var>Capacities</var> define the capacities of the water-jugs while <var>Visited</var> is a list of expanded (closed) node states. The breadth-first operation of solve_jugs is due to the existing <var>Nodes</var> being appended to the new nodes. (If the new nodes were appended to the existing nodes, the operation would be depth-first.) <pre class="prolog"> solve_jugs( [Node|Nodes], Capacities, Visited, End, Solution ) :- node_state( Node, State ), ( State = End -> Solution = Node ; otherwise -> findall( Successor, successor(Node, Capacities, Visited, Successor), Successors ), append( Nodes, Successors, NewNodes ), solve_jugs( NewNodes, Capacities, [State|Visited], End, Solution ) ). </pre> ====successor( +Node, +Capacities, +Visited, ?Successor )==== <var>Successor</var> is a successor of <var>Node</var>, for water-jugs with <var>Capacities</var>, if there is a legal transition from <var>Node</var>'s state to <var>Successor</var>'s state and <var>Successor</var>'s state is not a member of the <var>Visited</var> states. <pre class="prolog"> successor( Node, Capacities, Visited, Successor ) :- node_state( Node, State ), Successor = node(Action,State1,Node), jug_transition( State, Capacities, Action, State1 ), \+ member( State1, Visited ). </pre> ===Transition Rules=== ====jug_transition( +State, +Capacities, ?Action, ?SuccessorState )==== holds when <var>Action</var> describes a valid transition, from <var>State</var> to <var>SuccessorState</var>, for water-jugs with <var>Capacities</var>. There are two sorts of <var>Action</var>: * <code>empty_into(Source,Target)</code> valid if ''Source'' is not already empty and the combined contents from ''Source'' and ''Target'', in <var>State</var>, are not greater than the capacity of the ''Target'' jug. The ''Source'' jug becomes empty in <var>SuccessorState</var> while the ''Target'' jug acquires the combined contents of ''Source'' and ''Target'' in <var>State</var>. * <code>fill_from(Source,Target)</code> valid if ''Source'' is not already empty, and the combined contents from ''Source'' and ''Target'', in <var>State</var>, are greater than the capacity of the ''Target'' jug. The ''Target'' jug becomes full in <var>SuccessorState</var>, while ''Source'' retains the excess of the combined contents of ''Source'' and ''Target'' in <var>State</var>, over the capacity of the ''Target'' jug. In either case, the contents of the unused jug are unchanged. <pre class="prolog">jug_transition( State0, Capacities, Action, State1 ) :- volume( Source, State0, SourceContents ), SourceContents > 0, jug_permutation( Source, Target, Unused ), volume( Target, State0, TargetContents ), volume( Target, Capacities, TargetCapacity ), volume( Unused, State0, Unchanged ), volume( Unused, State1, Unchanged ), CombinedContents is SourceContents + TargetContents, ( CombinedContents =< TargetCapacity -> Action = empty_into(Source,Target), NewSourceContents = 0, NewTargetContents = CombinedContents ; CombinedContents > TargetCapacity -> Action = fill_from(Source,Target), NewSourceContents is CombinedContents-TargetCapacity, NewTargetContents = TargetCapacity ), volume( Source, State1, NewSourceContents ), volume( Target, State1, NewTargetContents ).</pre> ==Data Abstraction== ====volume( ?Jug, ?State, ?Volume )==== holds when <var>Jug</var> (large, small or reservoir) has <var>Volume</var> in <var>State</var>. <pre class="prolog"> volume( small, jugs(Small, _Large, _Reservoir), Small ). volume( large, jugs(_Small, Large, _Reservoir), Large ). volume( reservoir, jugs(_Small, _Large, Reservoir), Reservoir ). </pre> ====jug_permutation( ?Source, ?Target, ?Unused )==== holds when <var>Source</var>, <var>Target</var> and <var>Unused</var> are a permutation of <code>small</code>, <code>large</code> and <code>reservoir</code>. <pre class="prolog"> jug_permutation( Source, Target, Unused ) :- select( Source, [small, large, reservoir], Residue ), select( Target, Residue, [Unused] ). </pre> ====node_state( ?Node, ?State )==== holds when the contents of the water-jugs at <var>Node</var> are described by <var>State</var>. <pre class="prolog"> node_state( start(State), State ). node_state( node(_Transition, State, _Predecessor), State ). </pre> ==Definite Clause Grammar== ====narrative( +Solution, +Capacities, +End )/==== is a DCG presenting the water-jugs <var>Solution</var> in a readable format. The grammar is head-recursive because the <var>Solution</var> has the last node outermost. <pre class="prolog"> narrative( start(Start), Capacities, End ) --> "Given three jugs with capacities of:", newline, literal_volumes( Capacities ), "To obtain the result:", newline, literal_volumes( End ), "Starting with:", newline, literal_volumes( Start ), "Do the following:", newline. narrative( node(Transition, Result, Predecessor), Capacities, End ) --> narrative( Predecessor, Capacities, End ), literal_action( Transition, Result ). literal_volumes( Volumes ) --> indent, literal( Volumes ), ";", newline. literal_action( Transition, Result ) --> indent, "- ", literal( Transition ), " giving:", newline, indent, indent, literal( Result ), newline. literal( empty_into(From,To) ) --> "Empty the ", literal( From ), " into the ", literal( To ). literal( fill_from(From,To) ) --> "Fill the ", literal( To ), " from the ", literal( From ). literal( jugs(Small,Large,Reservoir) ) --> literal_number( Small ), " gallons in the small jug, ", literal_number( Large ), " gallons in the large jug and ", literal_number( Reservoir ), " gallons in the reservoir". literal( small ) --> "small jug". literal( large ) --> "large jug". literal( reservoir ) --> "reservoir". literal_number( Number, Plus, Minus ) :- number( Number ), name( Number, Chars ), append( Chars, Minus, Plus ). indent --> " ". newline --> " ". </pre> ==Utility Predicates== Load a small library of [[Puzzle Utilities]]. <pre class="prolog"> :- ensure_loaded( misc ). </pre> The code is available as plain text [https://binding-time.co.uk/download/water_jugs.txt here]. ==Output== The output of the program is: <div class="result"> <pre> ?- water_jugs. Given three jugs with capacities of: 3 gallons in the small jug, 4 gallons in the large jug and 8 gallons in the reservoir; To obtain the result: 0 gallons in the small jug, 2 gallons in the large jug and 6 gallons in the reservoir; Starting with: 0 gallons in the small jug, 0 gallons in the large jug and 8 gallons in the reservoir; Do the following: - Fill the small jug from the reservoir giving: 3 gallons in the small jug, 0 gallons in the large jug and 5 gallons in the reservoir - Empty the small jug into the large jug giving: 0 gallons in the small jug, 3 gallons in the large jug and 5 gallons in the reservoir - Fill the small jug from the reservoir giving: 3 gallons in the small jug, 3 gallons in the large jug and 2 gallons in the reservoir - Fill the large jug from the small jug giving: 2 gallons in the small jug, 4 gallons in the large jug and 2 gallons in the reservoir - Empty the large jug into the reservoir giving: 2 gallons in the small jug, 0 gallons in the large jug and 6 gallons in the reservoir - Empty the small jug into the large jug giving: 0 gallons in the small jug, 2 gallons in the large jug and 6 gallons in the reservoir yes </pre> </div> 49fbf5ed2b2fc4d4d9d0159056a1311c9f83a24c 217 206 2018-03-28T20:12:17Z John 2 Updated Amazon link wikitext text/x-wiki __NOTOC__ This classic AI problem is described in ''Artificial Intelligence'' as follows: <blockquote> &ldquo;You are given two jugs, a 4-gallon one and a 3-gallon one. Neither has any measuring markers on it. There is a tap that can be used to fill the jugs with water. How can you get exactly 2 gallons of water into the 4-gallon jug?&rdquo;. <cite>[http://amzn.to/2J3Dge3 E. Rich & K. Knight, Artificial Intelligence, 2nd edition, McGraw-Hill, 1991]</cite> </blockquote> This program implements an environmentally responsible solution to the ''water jugs'' problem. Rather than filling and spilling from an infinite water resource, we conserve a finite initial charge with a third jug: (reservoir). This approach is simpler than the traditional method because there are only two actions. It is more flexible than the traditional method because it can solve problems that are constrained by a limited supply from the reservoir. To simulate the infinite version, we use a filled reservoir with a capacity greater than the combined capacities of the jugs so that the reservoir can never be emptied. <blockquote> &ldquo;Perfection is achieved not when there is nothing more to add, but when there is nothing more to take away.&rdquo; <cite>[https://en.wikiquote.org/wiki/Antoine_de_Saint_Exup%C3%A9ry Antoine de Saint-Exup&#233;ry]</cite> </blockquote> ==Solution== ====water_jugs==== is the entry point. The solution is derived by a simple, breadth-first, state-space search, and translated into a readable format by a DCG. <pre class="prolog">water_jugs :- SmallCapacity = 3, LargeCapacity = 4, Reservoir is SmallCapacity + LargeCapacity + 1, volume( small, Capacities, SmallCapacity ), volume( large, Capacities, LargeCapacity ), volume( reservoir, Capacities, Reservoir ), volume( small, Start, 0 ), volume( large, Start, 0 ), volume( reservoir, Start, Reservoir ), volume( large, End, 2 ), water_jugs_solution( Start, Capacities, End, Solution ), phrase( narrative(Solution, Capacities, End), Chars ), put_chars( Chars ).</pre> ====water_jugs_solution( +Start, +Capacities, +End, ?Solution )==== holds when <var>Solution</var> is the terminal state in a state-space search that begins with an initial state, in which the water-jugs have <var>Capacities</var> and contain the <var>Start</var> volumes, and ends when the water-jugs contain the <var>End</var> volumes. <pre class="prolog"> water_jugs_solution( Start, Capacities, End, Solution ) :- solve_jugs( [start(Start)], Capacities, [], End, Solution ). </pre> ====solve_jugs( +Nodes, +Capacities, +Visited, +End, ?Solution )==== holds when <var>Solution</var> is the terminal node in a state-space search, beginning with a first open node in <var>Nodes</var>, and terminating when the water-jugs contain the <var>End</var> volumes. <var>Capacities</var> define the capacities of the water-jugs while <var>Visited</var> is a list of expanded (closed) node states. The breadth-first operation of solve_jugs is due to the existing <var>Nodes</var> being appended to the new nodes. (If the new nodes were appended to the existing nodes, the operation would be depth-first.) <pre class="prolog"> solve_jugs( [Node|Nodes], Capacities, Visited, End, Solution ) :- node_state( Node, State ), ( State = End -> Solution = Node ; otherwise -> findall( Successor, successor(Node, Capacities, Visited, Successor), Successors ), append( Nodes, Successors, NewNodes ), solve_jugs( NewNodes, Capacities, [State|Visited], End, Solution ) ). </pre> ====successor( +Node, +Capacities, +Visited, ?Successor )==== <var>Successor</var> is a successor of <var>Node</var>, for water-jugs with <var>Capacities</var>, if there is a legal transition from <var>Node</var>'s state to <var>Successor</var>'s state and <var>Successor</var>'s state is not a member of the <var>Visited</var> states. <pre class="prolog"> successor( Node, Capacities, Visited, Successor ) :- node_state( Node, State ), Successor = node(Action,State1,Node), jug_transition( State, Capacities, Action, State1 ), \+ member( State1, Visited ). </pre> ===Transition Rules=== ====jug_transition( +State, +Capacities, ?Action, ?SuccessorState )==== holds when <var>Action</var> describes a valid transition, from <var>State</var> to <var>SuccessorState</var>, for water-jugs with <var>Capacities</var>. There are two sorts of <var>Action</var>: * <code>empty_into(Source,Target)</code> valid if ''Source'' is not already empty and the combined contents from ''Source'' and ''Target'', in <var>State</var>, are not greater than the capacity of the ''Target'' jug. The ''Source'' jug becomes empty in <var>SuccessorState</var> while the ''Target'' jug acquires the combined contents of ''Source'' and ''Target'' in <var>State</var>. * <code>fill_from(Source,Target)</code> valid if ''Source'' is not already empty, and the combined contents from ''Source'' and ''Target'', in <var>State</var>, are greater than the capacity of the ''Target'' jug. The ''Target'' jug becomes full in <var>SuccessorState</var>, while ''Source'' retains the excess of the combined contents of ''Source'' and ''Target'' in <var>State</var>, over the capacity of the ''Target'' jug. In either case, the contents of the unused jug are unchanged. <pre class="prolog">jug_transition( State0, Capacities, Action, State1 ) :- volume( Source, State0, SourceContents ), SourceContents > 0, jug_permutation( Source, Target, Unused ), volume( Target, State0, TargetContents ), volume( Target, Capacities, TargetCapacity ), volume( Unused, State0, Unchanged ), volume( Unused, State1, Unchanged ), CombinedContents is SourceContents + TargetContents, ( CombinedContents =< TargetCapacity -> Action = empty_into(Source,Target), NewSourceContents = 0, NewTargetContents = CombinedContents ; CombinedContents > TargetCapacity -> Action = fill_from(Source,Target), NewSourceContents is CombinedContents-TargetCapacity, NewTargetContents = TargetCapacity ), volume( Source, State1, NewSourceContents ), volume( Target, State1, NewTargetContents ).</pre> ==Data Abstraction== ====volume( ?Jug, ?State, ?Volume )==== holds when <var>Jug</var> (large, small or reservoir) has <var>Volume</var> in <var>State</var>. <pre class="prolog"> volume( small, jugs(Small, _Large, _Reservoir), Small ). volume( large, jugs(_Small, Large, _Reservoir), Large ). volume( reservoir, jugs(_Small, _Large, Reservoir), Reservoir ). </pre> ====jug_permutation( ?Source, ?Target, ?Unused )==== holds when <var>Source</var>, <var>Target</var> and <var>Unused</var> are a permutation of <code>small</code>, <code>large</code> and <code>reservoir</code>. <pre class="prolog"> jug_permutation( Source, Target, Unused ) :- select( Source, [small, large, reservoir], Residue ), select( Target, Residue, [Unused] ). </pre> ====node_state( ?Node, ?State )==== holds when the contents of the water-jugs at <var>Node</var> are described by <var>State</var>. <pre class="prolog"> node_state( start(State), State ). node_state( node(_Transition, State, _Predecessor), State ). </pre> ==Definite Clause Grammar== ====narrative( +Solution, +Capacities, +End )/==== is a DCG presenting the water-jugs <var>Solution</var> in a readable format. The grammar is head-recursive because the <var>Solution</var> has the last node outermost. <pre class="prolog"> narrative( start(Start), Capacities, End ) --> "Given three jugs with capacities of:", newline, literal_volumes( Capacities ), "To obtain the result:", newline, literal_volumes( End ), "Starting with:", newline, literal_volumes( Start ), "Do the following:", newline. narrative( node(Transition, Result, Predecessor), Capacities, End ) --> narrative( Predecessor, Capacities, End ), literal_action( Transition, Result ). literal_volumes( Volumes ) --> indent, literal( Volumes ), ";", newline. literal_action( Transition, Result ) --> indent, "- ", literal( Transition ), " giving:", newline, indent, indent, literal( Result ), newline. literal( empty_into(From,To) ) --> "Empty the ", literal( From ), " into the ", literal( To ). literal( fill_from(From,To) ) --> "Fill the ", literal( To ), " from the ", literal( From ). literal( jugs(Small,Large,Reservoir) ) --> literal_number( Small ), " gallons in the small jug, ", literal_number( Large ), " gallons in the large jug and ", literal_number( Reservoir ), " gallons in the reservoir". literal( small ) --> "small jug". literal( large ) --> "large jug". literal( reservoir ) --> "reservoir". literal_number( Number, Plus, Minus ) :- number( Number ), name( Number, Chars ), append( Chars, Minus, Plus ). indent --> " ". newline --> " ". </pre> ==Utility Predicates== Load a small library of [[Puzzle Utilities]]. <pre class="prolog"> :- ensure_loaded( misc ). </pre> The code is available as plain text [https://binding-time.co.uk/download/water_jugs.txt here]. ==Output== The output of the program is: <div class="result"> <pre> ?- water_jugs. Given three jugs with capacities of: 3 gallons in the small jug, 4 gallons in the large jug and 8 gallons in the reservoir; To obtain the result: 0 gallons in the small jug, 2 gallons in the large jug and 6 gallons in the reservoir; Starting with: 0 gallons in the small jug, 0 gallons in the large jug and 8 gallons in the reservoir; Do the following: - Fill the small jug from the reservoir giving: 3 gallons in the small jug, 0 gallons in the large jug and 5 gallons in the reservoir - Empty the small jug into the large jug giving: 0 gallons in the small jug, 3 gallons in the large jug and 5 gallons in the reservoir - Fill the small jug from the reservoir giving: 3 gallons in the small jug, 3 gallons in the large jug and 2 gallons in the reservoir - Fill the large jug from the small jug giving: 2 gallons in the small jug, 4 gallons in the large jug and 2 gallons in the reservoir - Empty the large jug into the reservoir giving: 2 gallons in the small jug, 0 gallons in the large jug and 6 gallons in the reservoir - Empty the small jug into the large jug giving: 0 gallons in the small jug, 2 gallons in the large jug and 6 gallons in the reservoir yes </pre> </div> a1c3dee8a5f0c45edc4cddd2e8ecb4efeac183e7 226 217 2018-07-22T20:10:48Z John 2 Added "Three Glasses" footnote. wikitext text/x-wiki __NOTOC__ This classic AI problem is described in ''Artificial Intelligence'' as follows: <blockquote> &ldquo;You are given two jugs, a 4-gallon one and a 3-gallon one. Neither has any measuring markers on it. There is a tap that can be used to fill the jugs with water. How can you get exactly 2 gallons of water into the 4-gallon jug?&rdquo;. <cite>[https://www.amazon.co.uk/Artificial-Intelligence-Elaine-Rich/dp/0070522634/276-9442056-6625664?tag=bindingtimeli-21 E. Rich & K. Knight, Artificial Intelligence, 2nd edition, McGraw-Hill, 1991]</cite> </blockquote> This program implements an environmentally responsible solution to the ''water jugs'' problem. Rather than filling and spilling from an infinite water resource, we conserve a finite initial charge with a third jug: (reservoir). This approach is simpler than the traditional method because there are only two actions. It is more flexible than the traditional method because it can solve problems that are constrained by a limited supply from the reservoir<ref>For example, the "[https://www.cut-the-knot.org/water.shtml Three Glass Puzzle]" where the jugs have capacities of 8 (filled), 5 and 3 and the goal is to get two equal volumes (4).</ref>. To simulate the infinite version, we use a filled reservoir with a capacity greater than the combined capacities of the jugs so that the reservoir can never be emptied. <blockquote> &ldquo;Perfection is achieved not when there is nothing more to add, but when there is nothing more to take away.&rdquo; <cite>[https://en.wikiquote.org/wiki/Antoine_de_Saint_Exup%C3%A9ry Antoine de Saint-Exup&#233;ry]</cite> </blockquote> ==Solution== ====water_jugs==== is the entry point. The solution is derived by a simple, breadth-first, state-space search, and translated into a readable format by a DCG. <pre class="prolog">water_jugs :- SmallCapacity = 3, LargeCapacity = 4, Reservoir is SmallCapacity + LargeCapacity + 1, volume( small, Capacities, SmallCapacity ), volume( large, Capacities, LargeCapacity ), volume( reservoir, Capacities, Reservoir ), volume( small, Start, 0 ), volume( large, Start, 0 ), volume( reservoir, Start, Reservoir ), volume( large, End, 2 ), water_jugs_solution( Start, Capacities, End, Solution ), phrase( narrative(Solution, Capacities, End), Chars ), put_chars( Chars ).</pre> ====water_jugs_solution( +Start, +Capacities, +End, ?Solution )==== holds when <var>Solution</var> is the terminal state in a state-space search that begins with an initial state, in which the water-jugs have <var>Capacities</var> and contain the <var>Start</var> volumes, and ends when the water-jugs contain the <var>End</var> volumes. <pre class="prolog"> water_jugs_solution( Start, Capacities, End, Solution ) :- solve_jugs( [start(Start)], Capacities, [], End, Solution ). </pre> ====solve_jugs( +Nodes, +Capacities, +Visited, +End, ?Solution )==== holds when <var>Solution</var> is the terminal node in a state-space search, beginning with a first open node in <var>Nodes</var>, and terminating when the water-jugs contain the <var>End</var> volumes. <var>Capacities</var> define the capacities of the water-jugs while <var>Visited</var> is a list of expanded (closed) node states. The breadth-first operation of solve_jugs is due to the existing <var>Nodes</var> being appended to the new nodes. (If the new nodes were appended to the existing nodes, the operation would be depth-first.) <pre class="prolog"> solve_jugs( [Node|Nodes], Capacities, Visited, End, Solution ) :- node_state( Node, State ), ( State = End -> Solution = Node ; otherwise -> findall( Successor, successor(Node, Capacities, Visited, Successor), Successors ), append( Nodes, Successors, NewNodes ), solve_jugs( NewNodes, Capacities, [State|Visited], End, Solution ) ). </pre> ====successor( +Node, +Capacities, +Visited, ?Successor )==== <var>Successor</var> is a successor of <var>Node</var>, for water-jugs with <var>Capacities</var>, if there is a legal transition from <var>Node</var>'s state to <var>Successor</var>'s state and <var>Successor</var>'s state is not a member of the <var>Visited</var> states. <pre class="prolog"> successor( Node, Capacities, Visited, Successor ) :- node_state( Node, State ), Successor = node(Action,State1,Node), jug_transition( State, Capacities, Action, State1 ), \+ member( State1, Visited ). </pre> ===Transition Rules=== ====jug_transition( +State, +Capacities, ?Action, ?SuccessorState )==== holds when <var>Action</var> describes a valid transition, from <var>State</var> to <var>SuccessorState</var>, for water-jugs with <var>Capacities</var>. There are two sorts of <var>Action</var>: * <code>empty_into(Source,Target)</code> valid if ''Source'' is not already empty and the combined contents from ''Source'' and ''Target'', in <var>State</var>, are not greater than the capacity of the ''Target'' jug. The ''Source'' jug becomes empty in <var>SuccessorState</var> while the ''Target'' jug acquires the combined contents of ''Source'' and ''Target'' in <var>State</var>. * <code>fill_from(Source,Target)</code> valid if ''Source'' is not already empty, and the combined contents from ''Source'' and ''Target'', in <var>State</var>, are greater than the capacity of the ''Target'' jug. The ''Target'' jug becomes full in <var>SuccessorState</var>, while ''Source'' retains the excess of the combined contents of ''Source'' and ''Target'' in <var>State</var>, over the capacity of the ''Target'' jug. In either case, the contents of the unused jug are unchanged. <pre class="prolog">jug_transition( State0, Capacities, Action, State1 ) :- volume( Source, State0, SourceContents ), SourceContents > 0, jug_permutation( Source, Target, Unused ), volume( Target, State0, TargetContents ), volume( Target, Capacities, TargetCapacity ), volume( Unused, State0, Unchanged ), volume( Unused, State1, Unchanged ), CombinedContents is SourceContents + TargetContents, ( CombinedContents =< TargetCapacity -> Action = empty_into(Source,Target), NewSourceContents = 0, NewTargetContents = CombinedContents ; CombinedContents > TargetCapacity -> Action = fill_from(Source,Target), NewSourceContents is CombinedContents-TargetCapacity, NewTargetContents = TargetCapacity ), volume( Source, State1, NewSourceContents ), volume( Target, State1, NewTargetContents ).</pre> ==Data Abstraction== ====volume( ?Jug, ?State, ?Volume )==== holds when <var>Jug</var> (large, small or reservoir) has <var>Volume</var> in <var>State</var>. <pre class="prolog"> volume( small, jugs(Small, _Large, _Reservoir), Small ). volume( large, jugs(_Small, Large, _Reservoir), Large ). volume( reservoir, jugs(_Small, _Large, Reservoir), Reservoir ). </pre> ====jug_permutation( ?Source, ?Target, ?Unused )==== holds when <var>Source</var>, <var>Target</var> and <var>Unused</var> are a permutation of <code>small</code>, <code>large</code> and <code>reservoir</code>. <pre class="prolog"> jug_permutation( Source, Target, Unused ) :- select( Source, [small, large, reservoir], Residue ), select( Target, Residue, [Unused] ). </pre> ====node_state( ?Node, ?State )==== holds when the contents of the water-jugs at <var>Node</var> are described by <var>State</var>. <pre class="prolog"> node_state( start(State), State ). node_state( node(_Transition, State, _Predecessor), State ). </pre> ==Definite Clause Grammar== ====narrative( +Solution, +Capacities, +End )/==== is a DCG presenting the water-jugs <var>Solution</var> in a readable format. The grammar is head-recursive because the <var>Solution</var> has the last node outermost. <pre class="prolog"> narrative( start(Start), Capacities, End ) --> "Given three jugs with capacities of:", newline, literal_volumes( Capacities ), "To obtain the result:", newline, literal_volumes( End ), "Starting with:", newline, literal_volumes( Start ), "Do the following:", newline. narrative( node(Transition, Result, Predecessor), Capacities, End ) --> narrative( Predecessor, Capacities, End ), literal_action( Transition, Result ). literal_volumes( Volumes ) --> indent, literal( Volumes ), ";", newline. literal_action( Transition, Result ) --> indent, "- ", literal( Transition ), " giving:", newline, indent, indent, literal( Result ), newline. literal( empty_into(From,To) ) --> "Empty the ", literal( From ), " into the ", literal( To ). literal( fill_from(From,To) ) --> "Fill the ", literal( To ), " from the ", literal( From ). literal( jugs(Small,Large,Reservoir) ) --> literal_number( Small ), " gallons in the small jug, ", literal_number( Large ), " gallons in the large jug and ", literal_number( Reservoir ), " gallons in the reservoir". literal( small ) --> "small jug". literal( large ) --> "large jug". literal( reservoir ) --> "reservoir". literal_number( Number, Plus, Minus ) :- number( Number ), name( Number, Chars ), append( Chars, Minus, Plus ). indent --> " ". newline --> " ". </pre> ==Utility Predicates== Load a small library of [[Puzzle Utilities]]. <pre class="prolog"> :- ensure_loaded( misc ). </pre> The code is available as plain text [https://test.binding-time.co.uk/download/water_jugs.txt here]. ==Output== The output of the program is: <div class="result"> <pre> ?- water_jugs. Given three jugs with capacities of: 3 gallons in the small jug, 4 gallons in the large jug and 8 gallons in the reservoir; To obtain the result: 0 gallons in the small jug, 2 gallons in the large jug and 6 gallons in the reservoir; Starting with: 0 gallons in the small jug, 0 gallons in the large jug and 8 gallons in the reservoir; Do the following: - Fill the small jug from the reservoir giving: 3 gallons in the small jug, 0 gallons in the large jug and 5 gallons in the reservoir - Empty the small jug into the large jug giving: 0 gallons in the small jug, 3 gallons in the large jug and 5 gallons in the reservoir - Fill the small jug from the reservoir giving: 3 gallons in the small jug, 3 gallons in the large jug and 2 gallons in the reservoir - Fill the large jug from the small jug giving: 2 gallons in the small jug, 4 gallons in the large jug and 2 gallons in the reservoir - Empty the large jug into the reservoir giving: 2 gallons in the small jug, 0 gallons in the large jug and 6 gallons in the reservoir - Empty the small jug into the large jug giving: 0 gallons in the small jug, 2 gallons in the large jug and 6 gallons in the reservoir yes </pre> </div> ====Footnote==== <references/> 7f9e7906aed1783f22855630ec766e9459365b1e 227 226 2018-07-22T20:31:26Z John 2 Fix links wikitext text/x-wiki __NOTOC__ This classic AI problem is described in ''Artificial Intelligence'' as follows: <blockquote> &ldquo;You are given two jugs, a 4-gallon one and a 3-gallon one. Neither has any measuring markers on it. There is a tap that can be used to fill the jugs with water. How can you get exactly 2 gallons of water into the 4-gallon jug?&rdquo;. <cite>[http://amzn.to/2J3Dge3 E. Rich & K. Knight, Artificial Intelligence, 2nd edition, McGraw-Hill, 1991]</cite> </blockquote> This program implements an environmentally responsible solution to the ''water jugs'' problem. Rather than filling and spilling from an infinite water resource, we conserve a finite initial charge with a third jug: (reservoir). This approach is simpler than the traditional method because there are only two actions. It is more flexible than the traditional method because it can solve problems that are constrained by a limited supply from the reservoir<ref>For example, the "[https://www.cut-the-knot.org/water.shtml Three Glass Puzzle]" where the jugs have capacities of 8 (filled), 5 and 3 and the goal is to get two equal volumes (4).</ref>. To simulate the infinite version, we use a filled reservoir with a capacity greater than the combined capacities of the jugs so that the reservoir can never be emptied. <blockquote> &ldquo;Perfection is achieved not when there is nothing more to add, but when there is nothing more to take away.&rdquo; <cite>[https://en.wikiquote.org/wiki/Antoine_de_Saint_Exup%C3%A9ry Antoine de Saint-Exup&#233;ry]</cite> </blockquote> ==Solution== ====water_jugs==== is the entry point. The solution is derived by a simple, breadth-first, state-space search, and translated into a readable format by a DCG. <pre class="prolog">water_jugs :- SmallCapacity = 3, LargeCapacity = 4, Reservoir is SmallCapacity + LargeCapacity + 1, volume( small, Capacities, SmallCapacity ), volume( large, Capacities, LargeCapacity ), volume( reservoir, Capacities, Reservoir ), volume( small, Start, 0 ), volume( large, Start, 0 ), volume( reservoir, Start, Reservoir ), volume( large, End, 2 ), water_jugs_solution( Start, Capacities, End, Solution ), phrase( narrative(Solution, Capacities, End), Chars ), put_chars( Chars ).</pre> ====water_jugs_solution( +Start, +Capacities, +End, ?Solution )==== holds when <var>Solution</var> is the terminal state in a state-space search that begins with an initial state, in which the water-jugs have <var>Capacities</var> and contain the <var>Start</var> volumes, and ends when the water-jugs contain the <var>End</var> volumes. <pre class="prolog"> water_jugs_solution( Start, Capacities, End, Solution ) :- solve_jugs( [start(Start)], Capacities, [], End, Solution ). </pre> ====solve_jugs( +Nodes, +Capacities, +Visited, +End, ?Solution )==== holds when <var>Solution</var> is the terminal node in a state-space search, beginning with a first open node in <var>Nodes</var>, and terminating when the water-jugs contain the <var>End</var> volumes. <var>Capacities</var> define the capacities of the water-jugs while <var>Visited</var> is a list of expanded (closed) node states. The breadth-first operation of solve_jugs is due to the existing <var>Nodes</var> being appended to the new nodes. (If the new nodes were appended to the existing nodes, the operation would be depth-first.) <pre class="prolog"> solve_jugs( [Node|Nodes], Capacities, Visited, End, Solution ) :- node_state( Node, State ), ( State = End -> Solution = Node ; otherwise -> findall( Successor, successor(Node, Capacities, Visited, Successor), Successors ), append( Nodes, Successors, NewNodes ), solve_jugs( NewNodes, Capacities, [State|Visited], End, Solution ) ). </pre> ====successor( +Node, +Capacities, +Visited, ?Successor )==== <var>Successor</var> is a successor of <var>Node</var>, for water-jugs with <var>Capacities</var>, if there is a legal transition from <var>Node</var>'s state to <var>Successor</var>'s state and <var>Successor</var>'s state is not a member of the <var>Visited</var> states. <pre class="prolog"> successor( Node, Capacities, Visited, Successor ) :- node_state( Node, State ), Successor = node(Action,State1,Node), jug_transition( State, Capacities, Action, State1 ), \+ member( State1, Visited ). </pre> ===Transition Rules=== ====jug_transition( +State, +Capacities, ?Action, ?SuccessorState )==== holds when <var>Action</var> describes a valid transition, from <var>State</var> to <var>SuccessorState</var>, for water-jugs with <var>Capacities</var>. There are two sorts of <var>Action</var>: * <code>empty_into(Source,Target)</code> valid if ''Source'' is not already empty and the combined contents from ''Source'' and ''Target'', in <var>State</var>, are not greater than the capacity of the ''Target'' jug. The ''Source'' jug becomes empty in <var>SuccessorState</var> while the ''Target'' jug acquires the combined contents of ''Source'' and ''Target'' in <var>State</var>. * <code>fill_from(Source,Target)</code> valid if ''Source'' is not already empty, and the combined contents from ''Source'' and ''Target'', in <var>State</var>, are greater than the capacity of the ''Target'' jug. The ''Target'' jug becomes full in <var>SuccessorState</var>, while ''Source'' retains the excess of the combined contents of ''Source'' and ''Target'' in <var>State</var>, over the capacity of the ''Target'' jug. In either case, the contents of the unused jug are unchanged. <pre class="prolog">jug_transition( State0, Capacities, Action, State1 ) :- volume( Source, State0, SourceContents ), SourceContents > 0, jug_permutation( Source, Target, Unused ), volume( Target, State0, TargetContents ), volume( Target, Capacities, TargetCapacity ), volume( Unused, State0, Unchanged ), volume( Unused, State1, Unchanged ), CombinedContents is SourceContents + TargetContents, ( CombinedContents =< TargetCapacity -> Action = empty_into(Source,Target), NewSourceContents = 0, NewTargetContents = CombinedContents ; CombinedContents > TargetCapacity -> Action = fill_from(Source,Target), NewSourceContents is CombinedContents-TargetCapacity, NewTargetContents = TargetCapacity ), volume( Source, State1, NewSourceContents ), volume( Target, State1, NewTargetContents ).</pre> ==Data Abstraction== ====volume( ?Jug, ?State, ?Volume )==== holds when <var>Jug</var> (large, small or reservoir) has <var>Volume</var> in <var>State</var>. <pre class="prolog"> volume( small, jugs(Small, _Large, _Reservoir), Small ). volume( large, jugs(_Small, Large, _Reservoir), Large ). volume( reservoir, jugs(_Small, _Large, Reservoir), Reservoir ). </pre> ====jug_permutation( ?Source, ?Target, ?Unused )==== holds when <var>Source</var>, <var>Target</var> and <var>Unused</var> are a permutation of <code>small</code>, <code>large</code> and <code>reservoir</code>. <pre class="prolog"> jug_permutation( Source, Target, Unused ) :- select( Source, [small, large, reservoir], Residue ), select( Target, Residue, [Unused] ). </pre> ====node_state( ?Node, ?State )==== holds when the contents of the water-jugs at <var>Node</var> are described by <var>State</var>. <pre class="prolog"> node_state( start(State), State ). node_state( node(_Transition, State, _Predecessor), State ). </pre> ==Definite Clause Grammar== ====narrative( +Solution, +Capacities, +End )/==== is a DCG presenting the water-jugs <var>Solution</var> in a readable format. The grammar is head-recursive because the <var>Solution</var> has the last node outermost. <pre class="prolog"> narrative( start(Start), Capacities, End ) --> "Given three jugs with capacities of:", newline, literal_volumes( Capacities ), "To obtain the result:", newline, literal_volumes( End ), "Starting with:", newline, literal_volumes( Start ), "Do the following:", newline. narrative( node(Transition, Result, Predecessor), Capacities, End ) --> narrative( Predecessor, Capacities, End ), literal_action( Transition, Result ). literal_volumes( Volumes ) --> indent, literal( Volumes ), ";", newline. literal_action( Transition, Result ) --> indent, "- ", literal( Transition ), " giving:", newline, indent, indent, literal( Result ), newline. literal( empty_into(From,To) ) --> "Empty the ", literal( From ), " into the ", literal( To ). literal( fill_from(From,To) ) --> "Fill the ", literal( To ), " from the ", literal( From ). literal( jugs(Small,Large,Reservoir) ) --> literal_number( Small ), " gallons in the small jug, ", literal_number( Large ), " gallons in the large jug and ", literal_number( Reservoir ), " gallons in the reservoir". literal( small ) --> "small jug". literal( large ) --> "large jug". literal( reservoir ) --> "reservoir". literal_number( Number, Plus, Minus ) :- number( Number ), name( Number, Chars ), append( Chars, Minus, Plus ). indent --> " ". newline --> " ". </pre> ==Utility Predicates== Load a small library of [[Puzzle Utilities]]. <pre class="prolog"> :- ensure_loaded( misc ). </pre> The code is available as plain text [https://binding-time.co.uk/download/water_jugs.txt here]. ==Output== The output of the program is: <div class="result"> <pre> ?- water_jugs. Given three jugs with capacities of: 3 gallons in the small jug, 4 gallons in the large jug and 8 gallons in the reservoir; To obtain the result: 0 gallons in the small jug, 2 gallons in the large jug and 6 gallons in the reservoir; Starting with: 0 gallons in the small jug, 0 gallons in the large jug and 8 gallons in the reservoir; Do the following: - Fill the small jug from the reservoir giving: 3 gallons in the small jug, 0 gallons in the large jug and 5 gallons in the reservoir - Empty the small jug into the large jug giving: 0 gallons in the small jug, 3 gallons in the large jug and 5 gallons in the reservoir - Fill the small jug from the reservoir giving: 3 gallons in the small jug, 3 gallons in the large jug and 2 gallons in the reservoir - Fill the large jug from the small jug giving: 2 gallons in the small jug, 4 gallons in the large jug and 2 gallons in the reservoir - Empty the large jug into the reservoir giving: 2 gallons in the small jug, 0 gallons in the large jug and 6 gallons in the reservoir - Empty the small jug into the large jug giving: 0 gallons in the small jug, 2 gallons in the large jug and 6 gallons in the reservoir yes </pre> </div> ====Footnote==== <references/> ad4a7b3f38e39a65579f2c65760817a8bdaf1eb1 228 227 2018-07-22T20:41:20Z John 2 /* Footnote */ wikitext text/x-wiki __NOTOC__ This classic AI problem is described in ''Artificial Intelligence'' as follows: <blockquote> &ldquo;You are given two jugs, a 4-gallon one and a 3-gallon one. Neither has any measuring markers on it. There is a tap that can be used to fill the jugs with water. How can you get exactly 2 gallons of water into the 4-gallon jug?&rdquo;. <cite>[http://amzn.to/2J3Dge3 E. Rich & K. Knight, Artificial Intelligence, 2nd edition, McGraw-Hill, 1991]</cite> </blockquote> This program implements an environmentally responsible solution to the ''water jugs'' problem. Rather than filling and spilling from an infinite water resource, we conserve a finite initial charge with a third jug: (reservoir). This approach is simpler than the traditional method because there are only two actions. It is more flexible than the traditional method because it can solve problems that are constrained by a limited supply from the reservoir<ref>For example, the "[https://www.cut-the-knot.org/water.shtml Three Glass Puzzle]" where the jugs have capacities of 8 (filled), 5 and 3 and the goal is to get two equal volumes (4).</ref>. To simulate the infinite version, we use a filled reservoir with a capacity greater than the combined capacities of the jugs so that the reservoir can never be emptied. <blockquote> &ldquo;Perfection is achieved not when there is nothing more to add, but when there is nothing more to take away.&rdquo; <cite>[https://en.wikiquote.org/wiki/Antoine_de_Saint_Exup%C3%A9ry Antoine de Saint-Exup&#233;ry]</cite> </blockquote> ==Solution== ====water_jugs==== is the entry point. The solution is derived by a simple, breadth-first, state-space search, and translated into a readable format by a DCG. <pre class="prolog">water_jugs :- SmallCapacity = 3, LargeCapacity = 4, Reservoir is SmallCapacity + LargeCapacity + 1, volume( small, Capacities, SmallCapacity ), volume( large, Capacities, LargeCapacity ), volume( reservoir, Capacities, Reservoir ), volume( small, Start, 0 ), volume( large, Start, 0 ), volume( reservoir, Start, Reservoir ), volume( large, End, 2 ), water_jugs_solution( Start, Capacities, End, Solution ), phrase( narrative(Solution, Capacities, End), Chars ), put_chars( Chars ).</pre> ====water_jugs_solution( +Start, +Capacities, +End, ?Solution )==== holds when <var>Solution</var> is the terminal state in a state-space search that begins with an initial state, in which the water-jugs have <var>Capacities</var> and contain the <var>Start</var> volumes, and ends when the water-jugs contain the <var>End</var> volumes. <pre class="prolog"> water_jugs_solution( Start, Capacities, End, Solution ) :- solve_jugs( [start(Start)], Capacities, [], End, Solution ). </pre> ====solve_jugs( +Nodes, +Capacities, +Visited, +End, ?Solution )==== holds when <var>Solution</var> is the terminal node in a state-space search, beginning with a first open node in <var>Nodes</var>, and terminating when the water-jugs contain the <var>End</var> volumes. <var>Capacities</var> define the capacities of the water-jugs while <var>Visited</var> is a list of expanded (closed) node states. The breadth-first operation of solve_jugs is due to the existing <var>Nodes</var> being appended to the new nodes. (If the new nodes were appended to the existing nodes, the operation would be depth-first.) <pre class="prolog"> solve_jugs( [Node|Nodes], Capacities, Visited, End, Solution ) :- node_state( Node, State ), ( State = End -> Solution = Node ; otherwise -> findall( Successor, successor(Node, Capacities, Visited, Successor), Successors ), append( Nodes, Successors, NewNodes ), solve_jugs( NewNodes, Capacities, [State|Visited], End, Solution ) ). </pre> ====successor( +Node, +Capacities, +Visited, ?Successor )==== <var>Successor</var> is a successor of <var>Node</var>, for water-jugs with <var>Capacities</var>, if there is a legal transition from <var>Node</var>'s state to <var>Successor</var>'s state and <var>Successor</var>'s state is not a member of the <var>Visited</var> states. <pre class="prolog"> successor( Node, Capacities, Visited, Successor ) :- node_state( Node, State ), Successor = node(Action,State1,Node), jug_transition( State, Capacities, Action, State1 ), \+ member( State1, Visited ). </pre> ===Transition Rules=== ====jug_transition( +State, +Capacities, ?Action, ?SuccessorState )==== holds when <var>Action</var> describes a valid transition, from <var>State</var> to <var>SuccessorState</var>, for water-jugs with <var>Capacities</var>. There are two sorts of <var>Action</var>: * <code>empty_into(Source,Target)</code> valid if ''Source'' is not already empty and the combined contents from ''Source'' and ''Target'', in <var>State</var>, are not greater than the capacity of the ''Target'' jug. The ''Source'' jug becomes empty in <var>SuccessorState</var> while the ''Target'' jug acquires the combined contents of ''Source'' and ''Target'' in <var>State</var>. * <code>fill_from(Source,Target)</code> valid if ''Source'' is not already empty, and the combined contents from ''Source'' and ''Target'', in <var>State</var>, are greater than the capacity of the ''Target'' jug. The ''Target'' jug becomes full in <var>SuccessorState</var>, while ''Source'' retains the excess of the combined contents of ''Source'' and ''Target'' in <var>State</var>, over the capacity of the ''Target'' jug. In either case, the contents of the unused jug are unchanged. <pre class="prolog">jug_transition( State0, Capacities, Action, State1 ) :- volume( Source, State0, SourceContents ), SourceContents > 0, jug_permutation( Source, Target, Unused ), volume( Target, State0, TargetContents ), volume( Target, Capacities, TargetCapacity ), volume( Unused, State0, Unchanged ), volume( Unused, State1, Unchanged ), CombinedContents is SourceContents + TargetContents, ( CombinedContents =< TargetCapacity -> Action = empty_into(Source,Target), NewSourceContents = 0, NewTargetContents = CombinedContents ; CombinedContents > TargetCapacity -> Action = fill_from(Source,Target), NewSourceContents is CombinedContents-TargetCapacity, NewTargetContents = TargetCapacity ), volume( Source, State1, NewSourceContents ), volume( Target, State1, NewTargetContents ).</pre> ==Data Abstraction== ====volume( ?Jug, ?State, ?Volume )==== holds when <var>Jug</var> (large, small or reservoir) has <var>Volume</var> in <var>State</var>. <pre class="prolog"> volume( small, jugs(Small, _Large, _Reservoir), Small ). volume( large, jugs(_Small, Large, _Reservoir), Large ). volume( reservoir, jugs(_Small, _Large, Reservoir), Reservoir ). </pre> ====jug_permutation( ?Source, ?Target, ?Unused )==== holds when <var>Source</var>, <var>Target</var> and <var>Unused</var> are a permutation of <code>small</code>, <code>large</code> and <code>reservoir</code>. <pre class="prolog"> jug_permutation( Source, Target, Unused ) :- select( Source, [small, large, reservoir], Residue ), select( Target, Residue, [Unused] ). </pre> ====node_state( ?Node, ?State )==== holds when the contents of the water-jugs at <var>Node</var> are described by <var>State</var>. <pre class="prolog"> node_state( start(State), State ). node_state( node(_Transition, State, _Predecessor), State ). </pre> ==Definite Clause Grammar== ====narrative( +Solution, +Capacities, +End )/==== is a DCG presenting the water-jugs <var>Solution</var> in a readable format. The grammar is head-recursive because the <var>Solution</var> has the last node outermost. <pre class="prolog"> narrative( start(Start), Capacities, End ) --> "Given three jugs with capacities of:", newline, literal_volumes( Capacities ), "To obtain the result:", newline, literal_volumes( End ), "Starting with:", newline, literal_volumes( Start ), "Do the following:", newline. narrative( node(Transition, Result, Predecessor), Capacities, End ) --> narrative( Predecessor, Capacities, End ), literal_action( Transition, Result ). literal_volumes( Volumes ) --> indent, literal( Volumes ), ";", newline. literal_action( Transition, Result ) --> indent, "- ", literal( Transition ), " giving:", newline, indent, indent, literal( Result ), newline. literal( empty_into(From,To) ) --> "Empty the ", literal( From ), " into the ", literal( To ). literal( fill_from(From,To) ) --> "Fill the ", literal( To ), " from the ", literal( From ). literal( jugs(Small,Large,Reservoir) ) --> literal_number( Small ), " gallons in the small jug, ", literal_number( Large ), " gallons in the large jug and ", literal_number( Reservoir ), " gallons in the reservoir". literal( small ) --> "small jug". literal( large ) --> "large jug". literal( reservoir ) --> "reservoir". literal_number( Number, Plus, Minus ) :- number( Number ), name( Number, Chars ), append( Chars, Minus, Plus ). indent --> " ". newline --> " ". </pre> ==Utility Predicates== Load a small library of [[Puzzle Utilities]]. <pre class="prolog"> :- ensure_loaded( misc ). </pre> The code is available as plain text [https://binding-time.co.uk/download/water_jugs.txt here]. ==Output== The output of the program is: <div class="result"> <pre> ?- water_jugs. Given three jugs with capacities of: 3 gallons in the small jug, 4 gallons in the large jug and 8 gallons in the reservoir; To obtain the result: 0 gallons in the small jug, 2 gallons in the large jug and 6 gallons in the reservoir; Starting with: 0 gallons in the small jug, 0 gallons in the large jug and 8 gallons in the reservoir; Do the following: - Fill the small jug from the reservoir giving: 3 gallons in the small jug, 0 gallons in the large jug and 5 gallons in the reservoir - Empty the small jug into the large jug giving: 0 gallons in the small jug, 3 gallons in the large jug and 5 gallons in the reservoir - Fill the small jug from the reservoir giving: 3 gallons in the small jug, 3 gallons in the large jug and 2 gallons in the reservoir - Fill the large jug from the small jug giving: 2 gallons in the small jug, 4 gallons in the large jug and 2 gallons in the reservoir - Empty the large jug into the reservoir giving: 2 gallons in the small jug, 0 gallons in the large jug and 6 gallons in the reservoir - Empty the small jug into the large jug giving: 0 gallons in the small jug, 2 gallons in the large jug and 6 gallons in the reservoir yes </pre> </div> =====Footnote===== <references/> 9cb0f610cca07167c4b3b0bbc808f22b035bd6a7 229 228 2018-12-09T21:30:11Z John 2 Revert "Three Glasses" link to HTTP. wikitext text/x-wiki __NOTOC__ This classic AI problem is described in ''Artificial Intelligence'' as follows: <blockquote> &ldquo;You are given two jugs, a 4-gallon one and a 3-gallon one. Neither has any measuring markers on it. There is a tap that can be used to fill the jugs with water. How can you get exactly 2 gallons of water into the 4-gallon jug?&rdquo;. <cite>[http://amzn.to/2J3Dge3 E. Rich & K. Knight, Artificial Intelligence, 2nd edition, McGraw-Hill, 1991]</cite> </blockquote> This program implements an environmentally responsible solution to the ''water jugs'' problem. Rather than filling and spilling from an infinite water resource, we conserve a finite initial charge with a third jug: (reservoir). This approach is simpler than the traditional method because there are only two actions. It is more flexible than the traditional method because it can solve problems that are constrained by a limited supply from the reservoir<ref>For example, the "[http://www.cut-the-knot.org/water.shtml Three Glass Puzzle]" where the jugs have capacities of 8 (filled), 5 and 3 and the goal is to get two equal volumes (4).</ref>. To simulate the infinite version, we use a filled reservoir with a capacity greater than the combined capacities of the jugs so that the reservoir can never be emptied. <blockquote> &ldquo;Perfection is achieved not when there is nothing more to add, but when there is nothing more to take away.&rdquo; <cite>[https://en.wikiquote.org/wiki/Antoine_de_Saint_Exup%C3%A9ry Antoine de Saint-Exup&#233;ry]</cite> </blockquote> ==Solution== ====water_jugs==== is the entry point. The solution is derived by a simple, breadth-first, state-space search, and translated into a readable format by a DCG. <pre class="prolog">water_jugs :- SmallCapacity = 3, LargeCapacity = 4, Reservoir is SmallCapacity + LargeCapacity + 1, volume( small, Capacities, SmallCapacity ), volume( large, Capacities, LargeCapacity ), volume( reservoir, Capacities, Reservoir ), volume( small, Start, 0 ), volume( large, Start, 0 ), volume( reservoir, Start, Reservoir ), volume( large, End, 2 ), water_jugs_solution( Start, Capacities, End, Solution ), phrase( narrative(Solution, Capacities, End), Chars ), put_chars( Chars ).</pre> ====water_jugs_solution( +Start, +Capacities, +End, ?Solution )==== holds when <var>Solution</var> is the terminal state in a state-space search that begins with an initial state, in which the water-jugs have <var>Capacities</var> and contain the <var>Start</var> volumes, and ends when the water-jugs contain the <var>End</var> volumes. <pre class="prolog"> water_jugs_solution( Start, Capacities, End, Solution ) :- solve_jugs( [start(Start)], Capacities, [], End, Solution ). </pre> ====solve_jugs( +Nodes, +Capacities, +Visited, +End, ?Solution )==== holds when <var>Solution</var> is the terminal node in a state-space search, beginning with a first open node in <var>Nodes</var>, and terminating when the water-jugs contain the <var>End</var> volumes. <var>Capacities</var> define the capacities of the water-jugs while <var>Visited</var> is a list of expanded (closed) node states. The breadth-first operation of solve_jugs is due to the existing <var>Nodes</var> being appended to the new nodes. (If the new nodes were appended to the existing nodes, the operation would be depth-first.) <pre class="prolog"> solve_jugs( [Node|Nodes], Capacities, Visited, End, Solution ) :- node_state( Node, State ), ( State = End -> Solution = Node ; otherwise -> findall( Successor, successor(Node, Capacities, Visited, Successor), Successors ), append( Nodes, Successors, NewNodes ), solve_jugs( NewNodes, Capacities, [State|Visited], End, Solution ) ). </pre> ====successor( +Node, +Capacities, +Visited, ?Successor )==== <var>Successor</var> is a successor of <var>Node</var>, for water-jugs with <var>Capacities</var>, if there is a legal transition from <var>Node</var>'s state to <var>Successor</var>'s state and <var>Successor</var>'s state is not a member of the <var>Visited</var> states. <pre class="prolog"> successor( Node, Capacities, Visited, Successor ) :- node_state( Node, State ), Successor = node(Action,State1,Node), jug_transition( State, Capacities, Action, State1 ), \+ member( State1, Visited ). </pre> ===Transition Rules=== ====jug_transition( +State, +Capacities, ?Action, ?SuccessorState )==== holds when <var>Action</var> describes a valid transition, from <var>State</var> to <var>SuccessorState</var>, for water-jugs with <var>Capacities</var>. There are two sorts of <var>Action</var>: * <code>empty_into(Source,Target)</code> valid if ''Source'' is not already empty and the combined contents from ''Source'' and ''Target'', in <var>State</var>, are not greater than the capacity of the ''Target'' jug. The ''Source'' jug becomes empty in <var>SuccessorState</var> while the ''Target'' jug acquires the combined contents of ''Source'' and ''Target'' in <var>State</var>. * <code>fill_from(Source,Target)</code> valid if ''Source'' is not already empty, and the combined contents from ''Source'' and ''Target'', in <var>State</var>, are greater than the capacity of the ''Target'' jug. The ''Target'' jug becomes full in <var>SuccessorState</var>, while ''Source'' retains the excess of the combined contents of ''Source'' and ''Target'' in <var>State</var>, over the capacity of the ''Target'' jug. In either case, the contents of the unused jug are unchanged. <pre class="prolog">jug_transition( State0, Capacities, Action, State1 ) :- volume( Source, State0, SourceContents ), SourceContents > 0, jug_permutation( Source, Target, Unused ), volume( Target, State0, TargetContents ), volume( Target, Capacities, TargetCapacity ), volume( Unused, State0, Unchanged ), volume( Unused, State1, Unchanged ), CombinedContents is SourceContents + TargetContents, ( CombinedContents =< TargetCapacity -> Action = empty_into(Source,Target), NewSourceContents = 0, NewTargetContents = CombinedContents ; CombinedContents > TargetCapacity -> Action = fill_from(Source,Target), NewSourceContents is CombinedContents-TargetCapacity, NewTargetContents = TargetCapacity ), volume( Source, State1, NewSourceContents ), volume( Target, State1, NewTargetContents ).</pre> ==Data Abstraction== ====volume( ?Jug, ?State, ?Volume )==== holds when <var>Jug</var> (large, small or reservoir) has <var>Volume</var> in <var>State</var>. <pre class="prolog"> volume( small, jugs(Small, _Large, _Reservoir), Small ). volume( large, jugs(_Small, Large, _Reservoir), Large ). volume( reservoir, jugs(_Small, _Large, Reservoir), Reservoir ). </pre> ====jug_permutation( ?Source, ?Target, ?Unused )==== holds when <var>Source</var>, <var>Target</var> and <var>Unused</var> are a permutation of <code>small</code>, <code>large</code> and <code>reservoir</code>. <pre class="prolog"> jug_permutation( Source, Target, Unused ) :- select( Source, [small, large, reservoir], Residue ), select( Target, Residue, [Unused] ). </pre> ====node_state( ?Node, ?State )==== holds when the contents of the water-jugs at <var>Node</var> are described by <var>State</var>. <pre class="prolog"> node_state( start(State), State ). node_state( node(_Transition, State, _Predecessor), State ). </pre> ==Definite Clause Grammar== ====narrative( +Solution, +Capacities, +End )/==== is a DCG presenting the water-jugs <var>Solution</var> in a readable format. The grammar is head-recursive because the <var>Solution</var> has the last node outermost. <pre class="prolog"> narrative( start(Start), Capacities, End ) --> "Given three jugs with capacities of:", newline, literal_volumes( Capacities ), "To obtain the result:", newline, literal_volumes( End ), "Starting with:", newline, literal_volumes( Start ), "Do the following:", newline. narrative( node(Transition, Result, Predecessor), Capacities, End ) --> narrative( Predecessor, Capacities, End ), literal_action( Transition, Result ). literal_volumes( Volumes ) --> indent, literal( Volumes ), ";", newline. literal_action( Transition, Result ) --> indent, "- ", literal( Transition ), " giving:", newline, indent, indent, literal( Result ), newline. literal( empty_into(From,To) ) --> "Empty the ", literal( From ), " into the ", literal( To ). literal( fill_from(From,To) ) --> "Fill the ", literal( To ), " from the ", literal( From ). literal( jugs(Small,Large,Reservoir) ) --> literal_number( Small ), " gallons in the small jug, ", literal_number( Large ), " gallons in the large jug and ", literal_number( Reservoir ), " gallons in the reservoir". literal( small ) --> "small jug". literal( large ) --> "large jug". literal( reservoir ) --> "reservoir". literal_number( Number, Plus, Minus ) :- number( Number ), name( Number, Chars ), append( Chars, Minus, Plus ). indent --> " ". newline --> " ". </pre> ==Utility Predicates== Load a small library of [[Puzzle Utilities]]. <pre class="prolog"> :- ensure_loaded( misc ). </pre> The code is available as plain text [https://binding-time.co.uk/download/water_jugs.txt here]. ==Output== The output of the program is: <div class="result"> <pre> ?- water_jugs. Given three jugs with capacities of: 3 gallons in the small jug, 4 gallons in the large jug and 8 gallons in the reservoir; To obtain the result: 0 gallons in the small jug, 2 gallons in the large jug and 6 gallons in the reservoir; Starting with: 0 gallons in the small jug, 0 gallons in the large jug and 8 gallons in the reservoir; Do the following: - Fill the small jug from the reservoir giving: 3 gallons in the small jug, 0 gallons in the large jug and 5 gallons in the reservoir - Empty the small jug into the large jug giving: 0 gallons in the small jug, 3 gallons in the large jug and 5 gallons in the reservoir - Fill the small jug from the reservoir giving: 3 gallons in the small jug, 3 gallons in the large jug and 2 gallons in the reservoir - Fill the large jug from the small jug giving: 2 gallons in the small jug, 4 gallons in the large jug and 2 gallons in the reservoir - Empty the large jug into the reservoir giving: 2 gallons in the small jug, 0 gallons in the large jug and 6 gallons in the reservoir - Empty the small jug into the large jug giving: 0 gallons in the small jug, 2 gallons in the large jug and 6 gallons in the reservoir yes </pre> </div> =====Footnote===== <references/> ebcfb3b178b011aa144b6a58a5b8363036bea821 237 229 2019-12-05T00:05:45Z John 2 Book link upgraded to https wikitext text/x-wiki __NOTOC__ This classic AI problem is described in ''Artificial Intelligence'' as follows: <blockquote> &ldquo;You are given two jugs, a 4-gallon one and a 3-gallon one. Neither has any measuring markers on it. There is a tap that can be used to fill the jugs with water. How can you get exactly 2 gallons of water into the 4-gallon jug?&rdquo;. <cite>[https://amzn.to/2J3Dge3 E. Rich & K. Knight, Artificial Intelligence, 2nd edition, McGraw-Hill, 1991]</cite> </blockquote> This program implements an environmentally responsible solution to the ''water jugs'' problem. Rather than filling and spilling from an infinite water resource, we conserve a finite initial charge with a third jug: (reservoir). This approach is simpler than the traditional method because there are only two actions. It is more flexible than the traditional method because it can solve problems that are constrained by a limited supply from the reservoir<ref>For example, the "[http://www.cut-the-knot.org/water.shtml Three Glass Puzzle]" where the jugs have capacities of 8 (filled), 5 and 3 and the goal is to get two equal volumes (4).</ref>. To simulate the infinite version, we use a filled reservoir with a capacity greater than the combined capacities of the jugs so that the reservoir can never be emptied. <blockquote> &ldquo;Perfection is achieved not when there is nothing more to add, but when there is nothing more to take away.&rdquo; <cite>[https://en.wikiquote.org/wiki/Antoine_de_Saint_Exup%C3%A9ry Antoine de Saint-Exup&#233;ry]</cite> </blockquote> ==Solution== ====water_jugs==== is the entry point. The solution is derived by a simple, breadth-first, state-space search, and translated into a readable format by a DCG. <pre class="prolog">water_jugs :- SmallCapacity = 3, LargeCapacity = 4, Reservoir is SmallCapacity + LargeCapacity + 1, volume( small, Capacities, SmallCapacity ), volume( large, Capacities, LargeCapacity ), volume( reservoir, Capacities, Reservoir ), volume( small, Start, 0 ), volume( large, Start, 0 ), volume( reservoir, Start, Reservoir ), volume( large, End, 2 ), water_jugs_solution( Start, Capacities, End, Solution ), phrase( narrative(Solution, Capacities, End), Chars ), put_chars( Chars ).</pre> ====water_jugs_solution( +Start, +Capacities, +End, ?Solution )==== holds when <var>Solution</var> is the terminal state in a state-space search that begins with an initial state, in which the water-jugs have <var>Capacities</var> and contain the <var>Start</var> volumes, and ends when the water-jugs contain the <var>End</var> volumes. <pre class="prolog"> water_jugs_solution( Start, Capacities, End, Solution ) :- solve_jugs( [start(Start)], Capacities, [], End, Solution ). </pre> ====solve_jugs( +Nodes, +Capacities, +Visited, +End, ?Solution )==== holds when <var>Solution</var> is the terminal node in a state-space search, beginning with a first open node in <var>Nodes</var>, and terminating when the water-jugs contain the <var>End</var> volumes. <var>Capacities</var> define the capacities of the water-jugs while <var>Visited</var> is a list of expanded (closed) node states. The breadth-first operation of solve_jugs is due to the existing <var>Nodes</var> being appended to the new nodes. (If the new nodes were appended to the existing nodes, the operation would be depth-first.) <pre class="prolog"> solve_jugs( [Node|Nodes], Capacities, Visited, End, Solution ) :- node_state( Node, State ), ( State = End -> Solution = Node ; otherwise -> findall( Successor, successor(Node, Capacities, Visited, Successor), Successors ), append( Nodes, Successors, NewNodes ), solve_jugs( NewNodes, Capacities, [State|Visited], End, Solution ) ). </pre> ====successor( +Node, +Capacities, +Visited, ?Successor )==== <var>Successor</var> is a successor of <var>Node</var>, for water-jugs with <var>Capacities</var>, if there is a legal transition from <var>Node</var>'s state to <var>Successor</var>'s state and <var>Successor</var>'s state is not a member of the <var>Visited</var> states. <pre class="prolog"> successor( Node, Capacities, Visited, Successor ) :- node_state( Node, State ), Successor = node(Action,State1,Node), jug_transition( State, Capacities, Action, State1 ), \+ member( State1, Visited ). </pre> ===Transition Rules=== ====jug_transition( +State, +Capacities, ?Action, ?SuccessorState )==== holds when <var>Action</var> describes a valid transition, from <var>State</var> to <var>SuccessorState</var>, for water-jugs with <var>Capacities</var>. There are two sorts of <var>Action</var>: * <code>empty_into(Source,Target)</code> valid if ''Source'' is not already empty and the combined contents from ''Source'' and ''Target'', in <var>State</var>, are not greater than the capacity of the ''Target'' jug. The ''Source'' jug becomes empty in <var>SuccessorState</var> while the ''Target'' jug acquires the combined contents of ''Source'' and ''Target'' in <var>State</var>. * <code>fill_from(Source,Target)</code> valid if ''Source'' is not already empty, and the combined contents from ''Source'' and ''Target'', in <var>State</var>, are greater than the capacity of the ''Target'' jug. The ''Target'' jug becomes full in <var>SuccessorState</var>, while ''Source'' retains the excess of the combined contents of ''Source'' and ''Target'' in <var>State</var>, over the capacity of the ''Target'' jug. In either case, the contents of the unused jug are unchanged. <pre class="prolog">jug_transition( State0, Capacities, Action, State1 ) :- volume( Source, State0, SourceContents ), SourceContents > 0, jug_permutation( Source, Target, Unused ), volume( Target, State0, TargetContents ), volume( Target, Capacities, TargetCapacity ), volume( Unused, State0, Unchanged ), volume( Unused, State1, Unchanged ), CombinedContents is SourceContents + TargetContents, ( CombinedContents =< TargetCapacity -> Action = empty_into(Source,Target), NewSourceContents = 0, NewTargetContents = CombinedContents ; CombinedContents > TargetCapacity -> Action = fill_from(Source,Target), NewSourceContents is CombinedContents-TargetCapacity, NewTargetContents = TargetCapacity ), volume( Source, State1, NewSourceContents ), volume( Target, State1, NewTargetContents ).</pre> ==Data Abstraction== ====volume( ?Jug, ?State, ?Volume )==== holds when <var>Jug</var> (large, small or reservoir) has <var>Volume</var> in <var>State</var>. <pre class="prolog"> volume( small, jugs(Small, _Large, _Reservoir), Small ). volume( large, jugs(_Small, Large, _Reservoir), Large ). volume( reservoir, jugs(_Small, _Large, Reservoir), Reservoir ). </pre> ====jug_permutation( ?Source, ?Target, ?Unused )==== holds when <var>Source</var>, <var>Target</var> and <var>Unused</var> are a permutation of <code>small</code>, <code>large</code> and <code>reservoir</code>. <pre class="prolog"> jug_permutation( Source, Target, Unused ) :- select( Source, [small, large, reservoir], Residue ), select( Target, Residue, [Unused] ). </pre> ====node_state( ?Node, ?State )==== holds when the contents of the water-jugs at <var>Node</var> are described by <var>State</var>. <pre class="prolog"> node_state( start(State), State ). node_state( node(_Transition, State, _Predecessor), State ). </pre> ==Definite Clause Grammar== ====narrative( +Solution, +Capacities, +End )/==== is a DCG presenting the water-jugs <var>Solution</var> in a readable format. The grammar is head-recursive because the <var>Solution</var> has the last node outermost. <pre class="prolog"> narrative( start(Start), Capacities, End ) --> "Given three jugs with capacities of:", newline, literal_volumes( Capacities ), "To obtain the result:", newline, literal_volumes( End ), "Starting with:", newline, literal_volumes( Start ), "Do the following:", newline. narrative( node(Transition, Result, Predecessor), Capacities, End ) --> narrative( Predecessor, Capacities, End ), literal_action( Transition, Result ). literal_volumes( Volumes ) --> indent, literal( Volumes ), ";", newline. literal_action( Transition, Result ) --> indent, "- ", literal( Transition ), " giving:", newline, indent, indent, literal( Result ), newline. literal( empty_into(From,To) ) --> "Empty the ", literal( From ), " into the ", literal( To ). literal( fill_from(From,To) ) --> "Fill the ", literal( To ), " from the ", literal( From ). literal( jugs(Small,Large,Reservoir) ) --> literal_number( Small ), " gallons in the small jug, ", literal_number( Large ), " gallons in the large jug and ", literal_number( Reservoir ), " gallons in the reservoir". literal( small ) --> "small jug". literal( large ) --> "large jug". literal( reservoir ) --> "reservoir". literal_number( Number, Plus, Minus ) :- number( Number ), name( Number, Chars ), append( Chars, Minus, Plus ). indent --> " ". newline --> " ". </pre> ==Utility Predicates== Load a small library of [[Puzzle Utilities]]. <pre class="prolog"> :- ensure_loaded( misc ). </pre> The code is available as plain text [https://binding-time.co.uk/download/water_jugs.txt here]. ==Output== The output of the program is: <div class="result"> <pre> ?- water_jugs. Given three jugs with capacities of: 3 gallons in the small jug, 4 gallons in the large jug and 8 gallons in the reservoir; To obtain the result: 0 gallons in the small jug, 2 gallons in the large jug and 6 gallons in the reservoir; Starting with: 0 gallons in the small jug, 0 gallons in the large jug and 8 gallons in the reservoir; Do the following: - Fill the small jug from the reservoir giving: 3 gallons in the small jug, 0 gallons in the large jug and 5 gallons in the reservoir - Empty the small jug into the large jug giving: 0 gallons in the small jug, 3 gallons in the large jug and 5 gallons in the reservoir - Fill the small jug from the reservoir giving: 3 gallons in the small jug, 3 gallons in the large jug and 2 gallons in the reservoir - Fill the large jug from the small jug giving: 2 gallons in the small jug, 4 gallons in the large jug and 2 gallons in the reservoir - Empty the large jug into the reservoir giving: 2 gallons in the small jug, 0 gallons in the large jug and 6 gallons in the reservoir - Empty the small jug into the large jug giving: 0 gallons in the small jug, 2 gallons in the large jug and 6 gallons in the reservoir yes </pre> </div> =====Footnote===== <references/> 6b2ac92a0122cf3421e15c9c01caae663ea00387 247 237 2021-02-07T17:05:58Z John 2 Replacing broken Amazon link with a Worldcat link. wikitext text/x-wiki __NOTOC__ This classic AI problem is described in ''Artificial Intelligence'' as follows: <blockquote> &ldquo;You are given two jugs, a 4-gallon one and a 3-gallon one. Neither has any measuring markers on it. There is a tap that can be used to fill the jugs with water. How can you get exactly 2 gallons of water into the 4-gallon jug?&rdquo;. <cite>[https://www.worldcat.org/title/artificial-intelligence/oclc/473650331/editions E. Rich & K. Knight, Artificial Intelligence, 2nd edition, McGraw-Hill, 1991]</cite> </blockquote> This program implements an environmentally responsible solution to the ''water jugs'' problem. Rather than filling and spilling from an infinite water resource, we conserve a finite initial charge with a third jug: (reservoir). This approach is simpler than the traditional method because there are only two actions. It is more flexible than the traditional method because it can solve problems that are constrained by a limited supply from the reservoir<ref>For example, the "[http://www.cut-the-knot.org/water.shtml Three Glass Puzzle]" where the jugs have capacities of 8 (filled), 5 and 3 and the goal is to get two equal volumes (4).</ref>. To simulate the infinite version, we use a filled reservoir with a capacity greater than the combined capacities of the jugs so that the reservoir can never be emptied. <blockquote> &ldquo;Perfection is achieved not when there is nothing more to add, but when there is nothing more to take away.&rdquo; <cite>[https://en.wikiquote.org/wiki/Antoine_de_Saint_Exup%C3%A9ry Antoine de Saint-Exup&#233;ry]</cite> </blockquote> ==Solution== ====water_jugs==== is the entry point. The solution is derived by a simple, breadth-first, state-space search, and translated into a readable format by a DCG. <pre class="prolog">water_jugs :- SmallCapacity = 3, LargeCapacity = 4, Reservoir is SmallCapacity + LargeCapacity + 1, volume( small, Capacities, SmallCapacity ), volume( large, Capacities, LargeCapacity ), volume( reservoir, Capacities, Reservoir ), volume( small, Start, 0 ), volume( large, Start, 0 ), volume( reservoir, Start, Reservoir ), volume( large, End, 2 ), water_jugs_solution( Start, Capacities, End, Solution ), phrase( narrative(Solution, Capacities, End), Chars ), put_chars( Chars ).</pre> ====water_jugs_solution( +Start, +Capacities, +End, ?Solution )==== holds when <var>Solution</var> is the terminal state in a state-space search that begins with an initial state, in which the water-jugs have <var>Capacities</var> and contain the <var>Start</var> volumes, and ends when the water-jugs contain the <var>End</var> volumes. <pre class="prolog"> water_jugs_solution( Start, Capacities, End, Solution ) :- solve_jugs( [start(Start)], Capacities, [], End, Solution ). </pre> ====solve_jugs( +Nodes, +Capacities, +Visited, +End, ?Solution )==== holds when <var>Solution</var> is the terminal node in a state-space search, beginning with a first open node in <var>Nodes</var>, and terminating when the water-jugs contain the <var>End</var> volumes. <var>Capacities</var> define the capacities of the water-jugs while <var>Visited</var> is a list of expanded (closed) node states. The breadth-first operation of solve_jugs is due to the existing <var>Nodes</var> being appended to the new nodes. (If the new nodes were appended to the existing nodes, the operation would be depth-first.) <pre class="prolog"> solve_jugs( [Node|Nodes], Capacities, Visited, End, Solution ) :- node_state( Node, State ), ( State = End -> Solution = Node ; otherwise -> findall( Successor, successor(Node, Capacities, Visited, Successor), Successors ), append( Nodes, Successors, NewNodes ), solve_jugs( NewNodes, Capacities, [State|Visited], End, Solution ) ). </pre> ====successor( +Node, +Capacities, +Visited, ?Successor )==== <var>Successor</var> is a successor of <var>Node</var>, for water-jugs with <var>Capacities</var>, if there is a legal transition from <var>Node</var>'s state to <var>Successor</var>'s state and <var>Successor</var>'s state is not a member of the <var>Visited</var> states. <pre class="prolog"> successor( Node, Capacities, Visited, Successor ) :- node_state( Node, State ), Successor = node(Action,State1,Node), jug_transition( State, Capacities, Action, State1 ), \+ member( State1, Visited ). </pre> ===Transition Rules=== ====jug_transition( +State, +Capacities, ?Action, ?SuccessorState )==== holds when <var>Action</var> describes a valid transition, from <var>State</var> to <var>SuccessorState</var>, for water-jugs with <var>Capacities</var>. There are two sorts of <var>Action</var>: * <code>empty_into(Source,Target)</code> valid if ''Source'' is not already empty and the combined contents from ''Source'' and ''Target'', in <var>State</var>, are not greater than the capacity of the ''Target'' jug. The ''Source'' jug becomes empty in <var>SuccessorState</var> while the ''Target'' jug acquires the combined contents of ''Source'' and ''Target'' in <var>State</var>. * <code>fill_from(Source,Target)</code> valid if ''Source'' is not already empty, and the combined contents from ''Source'' and ''Target'', in <var>State</var>, are greater than the capacity of the ''Target'' jug. The ''Target'' jug becomes full in <var>SuccessorState</var>, while ''Source'' retains the excess of the combined contents of ''Source'' and ''Target'' in <var>State</var>, over the capacity of the ''Target'' jug. In either case, the contents of the unused jug are unchanged. <pre class="prolog">jug_transition( State0, Capacities, Action, State1 ) :- volume( Source, State0, SourceContents ), SourceContents > 0, jug_permutation( Source, Target, Unused ), volume( Target, State0, TargetContents ), volume( Target, Capacities, TargetCapacity ), volume( Unused, State0, Unchanged ), volume( Unused, State1, Unchanged ), CombinedContents is SourceContents + TargetContents, ( CombinedContents =< TargetCapacity -> Action = empty_into(Source,Target), NewSourceContents = 0, NewTargetContents = CombinedContents ; CombinedContents > TargetCapacity -> Action = fill_from(Source,Target), NewSourceContents is CombinedContents-TargetCapacity, NewTargetContents = TargetCapacity ), volume( Source, State1, NewSourceContents ), volume( Target, State1, NewTargetContents ).</pre> ==Data Abstraction== ====volume( ?Jug, ?State, ?Volume )==== holds when <var>Jug</var> (large, small or reservoir) has <var>Volume</var> in <var>State</var>. <pre class="prolog"> volume( small, jugs(Small, _Large, _Reservoir), Small ). volume( large, jugs(_Small, Large, _Reservoir), Large ). volume( reservoir, jugs(_Small, _Large, Reservoir), Reservoir ). </pre> ====jug_permutation( ?Source, ?Target, ?Unused )==== holds when <var>Source</var>, <var>Target</var> and <var>Unused</var> are a permutation of <code>small</code>, <code>large</code> and <code>reservoir</code>. <pre class="prolog"> jug_permutation( Source, Target, Unused ) :- select( Source, [small, large, reservoir], Residue ), select( Target, Residue, [Unused] ). </pre> ====node_state( ?Node, ?State )==== holds when the contents of the water-jugs at <var>Node</var> are described by <var>State</var>. <pre class="prolog"> node_state( start(State), State ). node_state( node(_Transition, State, _Predecessor), State ). </pre> ==Definite Clause Grammar== ====narrative( +Solution, +Capacities, +End )/==== is a DCG presenting the water-jugs <var>Solution</var> in a readable format. The grammar is head-recursive because the <var>Solution</var> has the last node outermost. <pre class="prolog"> narrative( start(Start), Capacities, End ) --> "Given three jugs with capacities of:", newline, literal_volumes( Capacities ), "To obtain the result:", newline, literal_volumes( End ), "Starting with:", newline, literal_volumes( Start ), "Do the following:", newline. narrative( node(Transition, Result, Predecessor), Capacities, End ) --> narrative( Predecessor, Capacities, End ), literal_action( Transition, Result ). literal_volumes( Volumes ) --> indent, literal( Volumes ), ";", newline. literal_action( Transition, Result ) --> indent, "- ", literal( Transition ), " giving:", newline, indent, indent, literal( Result ), newline. literal( empty_into(From,To) ) --> "Empty the ", literal( From ), " into the ", literal( To ). literal( fill_from(From,To) ) --> "Fill the ", literal( To ), " from the ", literal( From ). literal( jugs(Small,Large,Reservoir) ) --> literal_number( Small ), " gallons in the small jug, ", literal_number( Large ), " gallons in the large jug and ", literal_number( Reservoir ), " gallons in the reservoir". literal( small ) --> "small jug". literal( large ) --> "large jug". literal( reservoir ) --> "reservoir". literal_number( Number, Plus, Minus ) :- number( Number ), name( Number, Chars ), append( Chars, Minus, Plus ). indent --> " ". newline --> " ". </pre> ==Utility Predicates== Load a small library of [[Puzzle Utilities]]. <pre class="prolog"> :- ensure_loaded( misc ). </pre> The code is available as plain text [https://binding-time.co.uk/download/water_jugs.txt here]. ==Output== The output of the program is: <div class="result"> <pre> ?- water_jugs. Given three jugs with capacities of: 3 gallons in the small jug, 4 gallons in the large jug and 8 gallons in the reservoir; To obtain the result: 0 gallons in the small jug, 2 gallons in the large jug and 6 gallons in the reservoir; Starting with: 0 gallons in the small jug, 0 gallons in the large jug and 8 gallons in the reservoir; Do the following: - Fill the small jug from the reservoir giving: 3 gallons in the small jug, 0 gallons in the large jug and 5 gallons in the reservoir - Empty the small jug into the large jug giving: 0 gallons in the small jug, 3 gallons in the large jug and 5 gallons in the reservoir - Fill the small jug from the reservoir giving: 3 gallons in the small jug, 3 gallons in the large jug and 2 gallons in the reservoir - Fill the large jug from the small jug giving: 2 gallons in the small jug, 4 gallons in the large jug and 2 gallons in the reservoir - Empty the large jug into the reservoir giving: 2 gallons in the small jug, 0 gallons in the large jug and 6 gallons in the reservoir - Empty the small jug into the large jug giving: 0 gallons in the small jug, 2 gallons in the large jug and 6 gallons in the reservoir yes </pre> </div> =====Footnote===== <references/> 213f6249926631d86a5018bbb83cac83c451b892 0 2 207 200 2018-01-13T20:36:44Z John 2 /* select_coins( +Part, +Coins, ?Sample, ?Residue, ?N ) */ wikitext text/x-wiki __NOTOC__ ==Problem Definition== We are given 12 apparently identical coins - one of which is counterfeit. We know that the counterfeit has a different weight from the others, but we don't know if it's heavier or lighter. ===Task:=== Devise a procedure to identify any counterfeit coin using a balance to take up to three comparative weighings. ==Strategy== The information from three suitable weighings will make all but one of the coins, which are untested initially, known_true. There are three alternative deductions that make a coin known_true: * if it is not_heavy and not_light &ndash; having been on both the comparatively lighter and heavier sides of imbalances; * if it was excluded from an imbalance; * if it was included in a balanced weighing. After three weighings there must be exactly one coin, the counterfeit, which is not known_true. If the counterfeit is not known_true and not_heavy we deduce that it must be light. If it is not known_true and not_light, it must be heavy. We use a generate-and-test method as follows: * Create the set of all possible counterfeits: 12 coins &times; 2 weights ; * Devise a procedure that can identify the first counterfeit coin; * Show that the same procedure works for every other counterfeit coin. ==Entry Point== ====go==== is the entry point. It solves the puzzle, then uses a DCG to pretty-print the resulting procedure. <pre class="prolog"> go :- coins_puzzle( Procedure ), phrase( general_explanation( Procedure ), Chars ), put_chars( Chars ). </pre> ====coins_puzzle( ?Procedure )==== generates the set of all possible counterfeit coins and finds, or proves, that <var>Procedure</var> can identify them all. <pre class="prolog"> coins_puzzle( Procedure ) :- coins( Coins ), counterfeit( Counterfeit, Coin, Weight ), findall( Counterfeit, (member(Coin,Coins), counterfeit_weight(Weight)), Counterfeits ), coins_puzzle_solution( Counterfeits, Procedure ). coins_puzzle_solution( [], _Procedure ). coins_puzzle_solution( [Counterfeit|Counterfeits], Procedure ) :- solve_coins( Counterfeit, Procedure ), coins_puzzle_solution( Counterfeits, Procedure ). </pre> A procedure is either ''done'', identifying a particular coin and whether it is heavy or light, or it is a ''step''. A ''step'' defines the coins to be placed on the <var>Left</var> and <var>Right</var> pans, with the residue remaining on the <var>Table</var>, and three <var>Branches</var>, one of which will be chosen depending on the outcome of the weighing. <pre class="prolog"> step( step(Left,Right,Table,Branches), Left, Right, Table, Branches). </pre> The <var>Branches</var> are three procedures equating to: * > (left pan heavier), * < (right pan heavier) and * <nowiki>= (pans balance).</nowiki> <pre class="prolog"> branch( >, branches(_Equal, GT, _LT), GT ). branch( <, branches(_Equal, _GT, LT), LT ). branch( =, branches(Equal, _GT, _LT), Equal ). </pre> The counterfeit is defined by its number and whether it is heavy or light. <pre class="prolog"> counterfeit( counterfeit(Coin, HeavyOrLight), Coin, HeavyOrLight ). coins( [1,2,3,4,5,6,7,8,9,10,11,12] ). counterfeit_weight( heavy ). counterfeit_weight( light ). </pre> A ''coin collection'' comprises four <code>part</code>s (subsets): the <code>known_true</code>, <code>not_heavy</code>, <code>not_light</code> and <code>untested</code> sets of coins. <pre class="prolog"> part( known_true, collection(Coins,_,_,_), Coins ). part( not_heavy, collection(_,Coins,_,_), Coins ). part( not_light, collection(_,_,Coins,_), Coins ). part( untested, collection(_,_,_,Coins), Coins ). </pre> ==Solution== ====solve_coins( +Counterfeit, ?Procedure )==== holds when <var>Procedure</var> can correctly identify the <var>Counterfeit</var> coin. Beginning with a ''start'' collection, in which all the coins are untested, the <var>Procedure</var> comprises three steps. For each step, a weighing is made and a ''branch'' is made in the <var>Procedure</var>, depending on the result of the weighing. After three steps, the <var>Procedure</var> must have reached the ''end'' condition. Finally, an assertion (redundant test) ensures that the <var>Procedure</var> has found the correct ''end'' condition. <pre class="prolog"> solve_coins( Counterfeit, Procedure ) :- start( Coins0 ), assay( Counterfeit, Coins0, Procedure, Branch1, Coins1 ), assay( Counterfeit, Coins1, Branch1, Branch2, Coins2 ), assay( Counterfeit, Coins2, Branch2, done(Coin, HeavyOrLight), Coins3 ), end( Coins3, Coin, HeavyOrLight ), counterfeit( Counterfeit, Coin, HeavyOrLight ). start( Coins ) :- coins( Untested ), part( untested, Coins, Untested ), part( not_heavy, Coins, [] ), part( not_light, Coins, [] ), part( known_true, Coins, [] ). end( Coins, Coin, HeavyOrLight ) :- part( untested, Coins, [] ), part( not_heavy, Coins, Light ), part( not_light, Coins, Heavy ), end_result( Heavy, Light, Coin, HeavyOrLight ). end_result( [Coin], [], Coin, heavy ). end_result( [], [Coin], Coin, light ). </pre> === Simulating the weighing process === ====assay( +Counterfeit, +Coins0, ?Step, ?Branch, ?Coins1 )==== holds when the appropriate <var>Branch</var> from <var>Step</var> is chosen by comparing the weights of two coin collections taken from the full set of coins: <var>Coins0</var>. <var>Coins1</var> is the full set of coins updated with the inferences drawn from the weighing, where <var>Counterfeit</var> is used to determine the result of the weighing. This predicate applies the critical insight into the solution of this puzzle: we have 24 (12 &times; 2) possible inputs to the procedure, with only 27 (3 &times; 3 &times; 3) possible outcomes from the weighings. Therefore, it is clear that each weighing must have a very high [[#Information Content|information content]]. Choosing which weighing to make by estimating the available information content makes the problem tractable. <pre class="prolog"> assay( Counterfeit, Coins0, Step, Branch, Coins ) :- step( Step, Left, Right, Table, Branches ), partition( Coins0, Left, Right, Table ), balance( Left, Right, Counterfeit, Result ), draw_inferences( Result, Left, Right, Table, Coins ), branch( Result, Branches, Branch ). </pre> ====balance( +Left, +Right, +Counterfeit, ?Result )==== holds when <var>Result</var> simulates the outcome of testing the coin collections <var>Left</var> and <var>Right</var> with a balance, where either may contain the <var>Counterfeit</var> coin. <pre class="prolog"> balance( Left, Right, Counterfeit, Result ):- counterfeit( Counterfeit, Coin, Weight ), ( contains_coin( Left, Coin ) -> balance_result( Weight, normal, Result ) ; contains_coin( Right, Coin ) -> balance_result( normal, Weight, Result ) ; otherwise -> Result = '=' ). balance_result( light, normal, < ). balance_result( heavy, normal, > ). balance_result( normal, heavy, < ). balance_result( normal, light, > ). </pre> ===Choosing which coins to weigh=== ====partition( +Coins, ?Left, ?Right, ?Table )==== holds when <var>Coins</var> is partitioned into three collections: <var>Left</var> side, <var>Right</var> side and <var>Table</var>. Operationally, alternative valid partitions are selected in order of reducing information content. <pre class="prolog"> partition( Coins, Left, Right, Table ) :- Partition = ptn(Info,Left,Right,Table), findall( Partition, valid_partition(Coins, Info, Left, Right, Table), Partitions ), sort( Partitions, OrderedPartitions ), member( Partition, OrderedPartitions ). </pre> ====valid_partition( +Coins, ?Content, ?Left, ?Right, ?Table )==== holds when <var>Coins</var> can be partitioned into three collections: <var>Left</var> side, <var>Right</var> side and <var>Table</var>; with the information content of the partition given by <var>Content</var>. The definition of a valid_partition ensures that: * <var>Left</var> and <var>Right</var> must have the same number of coins (at least one); * <var>Left</var> cannot contain any known_true coins, because adding true coins to both sides creates redundant comparisons; * Comparisons between mixtures of coins where only the choice of pans is different are equivalent, so a partial order (&ge;) on mixtures of coins is used to eliminate some redundant comparisons. <pre class="prolog"> valid_partition( Coins, Content, Left, Right, Table ):- part( known_true, Left, [] ), selection( Coins, Left, Coins1, LeftSum, LeftInfo ), selection( Coins1, Right, Table, RightSum, RightInfo ), LeftSum =:= RightSum, LeftSum @>= RightSum, table_information( Table, TableInfo ), sum( [LeftInfo,RightInfo,TableInfo], Content ). </pre> ====selection( +Coins, ?Sample, ?Residue, ?Sum, ?Content )==== holds when <var>Coins</var> is partitioned into two collections: <var>Sample</var> and <var>Residue</var>. <var>Sum</var> is used as both a fingerprint for the mixture of coins in <var>Sample</var> and a representation of the number of coins in <var>Sample</var>. <var>Content</var> estimates the information-content of <var>Sample</var>. <pre class="prolog"> selection( Coins, Sample, Residue, Sum, Content ) :- Sum = Count1+Count2+Count3+Count4, select_coins( not_heavy, Coins, Sample, Residue, Count1 ), select_coins( not_light, Coins, Sample, Residue, Count2 ), select_coins( untested, Coins, Sample, Residue, Count3 ), select_coins( known_true, Coins, Sample, Residue, Count4 ), Sum >= 1, Sum =< 6, information_content( [Count1,Count2,Count3,Count4], Content ). </pre> ====table_information( +Coins, ?Content )==== holds when <var>Coins</var> has 'information content' <var>Content</var>. <pre class="prolog"> table_information( Coins, Content ) :- count_coins( not_heavy, Coins, Count1 ), count_coins( not_light, Coins, Count2 ), count_coins( untested, Coins, Count3 ), count_coins( known_true, Coins, Count4 ), information_content( [Count1,Count2,Count3,Count4], Content ). count_coins( Part, Coins, Count ) :- part( Part, Coins, Selection ), length( Selection, Count ). </pre> === Updating what is known about the coins === ====draw_inferences( +Result, +Left, +Right, +Table, ?Coins )==== holds when <var>Result</var> is one of: * > (imbalance &ndash; left pan heavier), * < (imbalance &ndash; right pan heavier) or * <nowiki>=</nowiki> (pans balanced) from taking a weighing with the coin collections: <var>Left</var>, <var>Right</var> and <var>Table</var>. <var>Coins</var> is derived from this information using the following rules: * If the pans are unbalanced then only the previously untested or not_heavy coins on the lighter side of the balance are now not_heavy. Similarly, only the previously untested or not_light coins on the heavier side of the balance are now not_light. All the coins on the table are now known_true. * If the pans balance then all the coins weighed are known_true, with the coins on the <var>Table</var> left in their prior states. <pre class="prolog"> draw_inferences( <, Left, Right, Table, Coins ) :- imbalance_inferences( Left, Right, Table, Coins ). draw_inferences( >, Left, Right, Table, Coins ) :- imbalance_inferences( Right, Left, Table, Coins ). draw_inferences( =, Left, Right, Table, Coins ) :- becomes( [all(Left),known_true(Table),all(Right)], known_true( Coins ) ), becomes( untested(Table), untested(Coins) ), becomes( not_heavy(Table), not_heavy(Coins) ), becomes( not_light(Table), not_light(Coins) ). </pre> ====imbalance_inferences( +Lighter, +Heavier, +Table, ?Coins )==== holds when: * Only the untested or not_heavy coins in <var>Lighter</var> are not_heavy in <var>Coins</var>; * Only the untested or not_light coins in <var>Heavier</var> are not_light in <var>Coins</var>; * All the other coins in <var>Lighter</var> and <var>Heavier</var> and all the coins in <var>Table</var> are known_true in <var>Coins</var>; There are no untested coins in <var>Coins</var>. <pre class="prolog"> imbalance_inferences( Lighter, Heavier, Table, Coins ) :- becomes( [untested(Lighter),not_heavy(Lighter)], not_heavy(Coins) ), becomes( [untested(Heavier),not_light(Heavier)], not_light(Coins) ), becomes( [ known_true(Lighter), not_light(Lighter), known_true(Heavier), not_heavy(Heavier), all(Table) ], known_true(Coins) ), part( untested, Coins, [] ). </pre> ====becomes( +CollectionA, ?CollectionB )==== <var>CollectionA</var> becomes (part) <var>CollectionB</var> when <var>CollectionB</var> comprises the same coins as <var>CollectionA</var>. <pre class="prolog"> becomes( CollectionA, CollectionB ) :- unfolded( CollectionA, Coins ), unfolded( CollectionB, Coins ). </pre> ====unfolded( +Collection, ?Coins )==== holds when (part) <var>Collection</var> comprises <var>Coins</var>. <pre class="prolog"> unfolded( not_light(Collection), Coins ) :- part( not_light, Collection, Coins ). unfolded( not_heavy(Collection), Coins ) :- part( not_heavy, Collection, Coins ). unfolded( known_true(Collection), Coins ) :- part( known_true, Collection, Coins ). unfolded( untested(Collection), Coins ) :- part( untested, Collection, Coins ). unfolded( all(Collection), Coins ) :- collection_to_set( Collection, Coins ). unfolded( [Item|Items], Coins ) :- unfolded( Item, Value ), unfolded1( Items, Value, Coins ). unfolded1( [], Coins, Coins ). unfolded1( [Item|Items], Value, Coins ) :- unfolded( Item, Value0 ), ord_union( Value0, Value, Value1 ), unfolded1( Items, Value1, Coins ). </pre> ==Definite Clause Grammar== The following DCG presents the method for finding the counterfeit coin as a structured procedure. <pre class="prolog"> general_explanation( Procedure ) --> "Number the coins 1..12", newline, explanation( Procedure, 0 ). explanation( done(Coin, Weight), N ) --> tab( N ), "Conclude that the counterfeit coin is number ", literal( Coin ), ", which is ", literal( Weight ), newline. explanation( Step, N ) --> {step( Step, Left, Right, Table, Branches )}, tab( N ), "BEGIN", newline, tab( N ), "Put ", literal( Left ), " on the left-hand pan", newline, tab( N ), "Put ", literal( Right ), " on the right-hand pan", newline, tab( N ), "Leaving ", literal( Table ), " on the table", newline, branches_explained( Branches, N ), tab( N ), "END", newline. branches_explained( Branches, N ) --> next_step_explained( <, Branches, N ), next_step_explained( >, Branches, N ), next_step_explained( =, Branches, N ). next_step_explained( Result, Branch, N ) --> {branch( Result, Branch, Step )}, ( {var(Step)} -> "" | {nonvar(Step)} -> tab( N ), "If the ", literal( Result ), " then:", newline, explanation( Step, s(N) ) ). literal( 0 ) --> "0". literal( 1 ) --> "1". literal( 2 ) --> "2". literal( 3 ) --> "3". literal( 4 ) --> "4". literal( 5 ) --> "5". literal( 6 ) --> "6". literal( 7 ) --> "7". literal( 8 ) --> "8". literal( 9 ) --> "9". literal( 10 ) --> "10". literal( 11 ) --> "11". literal( 12 ) --> "12". literal( true ) --> "true". literal( heavy ) --> "heavy". literal( light ) --> "light". literal( = ) --> "pans balance". literal( < ) --> "right-hand pan is heavier". literal( > ) --> "left-hand pan is heavier". literal( Collection ) --> {collection_to_set( Collection , [H|T] )}, literal_set( T, H ). literal_set( [], Number ) --> "the coin numbered ", literal( Number ). literal_set( [H|T], Number ) --> "the coins numbered ", literal( Number ), literal_set1( T, H ). literal_set1( [], Number ) --> " and ", literal( Number ). literal_set1( [H|T], Number ) --> ", ", literal( Number ), literal_set1( T, H ). tab( 0 ) --> "". tab( s(N) ) --> " ", tab( N ). newline --> " ". </pre> ===Utility Predicates=== ====contains_coin( ?Collection, ?Coin )==== holds when <var>Coin</var> is a member of <var>Collection</var>. <pre class="prolog"> contains_coin( Collection, Coin ) :- part( _Part, Collection, Coins ), member( Coin, Coins ). </pre> ====collection_to_set( +Collection, ?Set )==== holds when <var>Set</var> is the distributed union of the <code>known_true</code>, <code>not_heavy</code>, <code>not_light</code> and <code>untested</code> ordsets comprising <var>Collection</var>. <pre class="prolog"> collection_to_set( Collection, Set ) :- part( known_true, Collection, KnownTrue ), part( not_heavy, Collection, NotHeavy ), part( not_light, Collection, NotLight ), part( untested, Collection, Untested ), ord_union( [KnownTrue,NotHeavy,NotLight,Untested], Set ). </pre> ===Information Content=== ==== information_content( +Counts, ?Content ) ==== holds when <var>Content</var> is the cumulative negative entropy of <var>Counts</var>. A reduction in entropy equates to a gain in information. <pre class="prolog"> information_content( Counts, Content ) :- information_content1( Counts, 0, Content ). information_content1( [], Content, Content ). information_content1( [Count|Counts], Content0, Content ):- coins_entropy( Count, Entropy ), Content1 is Content0-Entropy, information_content1( Counts, Content1, Content ). </pre> ==== coins_entropy( ?N, ?Entropy ) ==== holds when <var>Entropy</var> estimates the entropy of a sample of <var>N</var> coins. <var>Entropy</var> = P log₂(¹&frasl;_P), where P = <var>N</var>&divide;12. <pre class="prolog"> coins_entropy( 0, 0.0 ). coins_entropy( 1, 0.2987 ). coins_entropy( 2, 0.4308 ). coins_entropy( 3, 0.5 ). coins_entropy( 4, 0.5283 ). coins_entropy( 5, 0.5263 ). coins_entropy( 6, 0.5 ). coins_entropy( 7, 0.4536 ). coins_entropy( 8, 0.39 ). coins_entropy( 9, 0.3113 ). coins_entropy( 10, 0.2192 ). coins_entropy( 11, 0.1151 ). coins_entropy( 12, 0.0 ). </pre> ====select_coins( +Part, +Coins, ?Sample, ?Residue, ?N )==== holds when <var>N</var> coins from <var>Part</var> of <var>Coins</var> form <var>Part</var> of <var>Sample</var>, with the remainder forming <var>Part</var> of <var>Residue</var>. <pre class="prolog"> select_coins( Part, Coins, Sample, Residue, Count ) :- part( Part, Coins, Input ), part( Part, Sample, Selection ), part( Part, Residue, Remainder ), select_n( Count, Input, Selection, Remainder ). select_n( 0, In, [], In ). select_n( 1, [A|Suffix], [A], Suffix ). select_n( 2, [A,B|Suffix], [A,B], Suffix ). select_n( 3, [A,B,C|Suffix], [A,B,C], Suffix ). select_n( 4, [A,B,C,D|Suffix], [A,B,C,D], Suffix ). select_n( 5, [A,B,C,D,E|Suffix], [A,B,C,D,E], Suffix ). select_n( 6, [A,B,C,D,E,F|Suffix], [A,B,C,D,E,F], Suffix ). </pre> Load a small library of [[Puzzle Utilities]]. <pre class="prolog"> :- ensure_loaded( misc ). </pre> Use the ordsets library. <pre class="prolog"> :- use_module( library(ordsets), [ord_union/2,ord_union/3] ). </pre> The code is available as plain text [https://binding-time.co.uk/download/counterfeit.txt here]. ==Output== <div class="result"> Number the coins 1..12 BEGIN Put the coins numbered 1, 2, 3 and 4 on the left-hand pan Put the coins numbered 5, 6, 7 and 8 on the right-hand pan Leaving the coins numbered 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 1, 2, 5 and 6 on the left-hand pan Put the coins numbered 3, 7, 9 and 10 on the right-hand pan Leaving the coins numbered 4, 8, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 1 and 7 on the left-hand pan Put the coins numbered 3 and 4 on the right-hand pan Leaving the coins numbered 2, 5, 6, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 1, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 7, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 2, which is light END If the left-hand pan is heavier then: BEGIN Put the coins numbered 3 and 5 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 4, 6, 7, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 3, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 5, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 6, which is heavy END If the pans balance then: BEGIN Put the coins numbered 4 and 8 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 3, 5, 6, 7, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 4, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 8, which is heavy END END If the left-hand pan is heavier then: BEGIN Put the coins numbered 1, 2, 5 and 6 on the left-hand pan Put the coins numbered 3, 7, 9 and 10 on the right-hand pan Leaving the coins numbered 4, 8, 11 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coins numbered 3 and 5 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 4, 6, 7, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 5, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 3, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 6, which is light END If the left-hand pan is heavier then: BEGIN Put the coins numbered 1 and 7 on the left-hand pan Put the coins numbered 3 and 4 on the right-hand pan Leaving the coins numbered 2, 5, 6, 8, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 7, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 1, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 2, which is heavy END If the pans balance then: BEGIN Put the coins numbered 4 and 8 on the left-hand pan Put the coins numbered 1 and 2 on the right-hand pan Leaving the coins numbered 3, 5, 6, 7, 9, 10, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 8, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 4, which is heavy END END If the pans balance then: BEGIN Put the coins numbered 9, 10 and 11 on the left-hand pan Put the coins numbered 1, 2 and 3 on the right-hand pan Leaving the coins numbered 4, 5, 6, 7, 8 and 12 on the table If the right-hand pan is heavier then: BEGIN Put the coin numbered 9 on the left-hand pan Put the coin numbered 10 on the right-hand pan Leaving the coins numbered 1, 2, 3, 4, 5, 6, 7, 8, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 9, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 10, which is light If the pans balance then: Conclude that the counterfeit coin is number 11, which is light END If the left-hand pan is heavier then: BEGIN Put the coin numbered 9 on the left-hand pan Put the coin numbered 10 on the right-hand pan Leaving the coins numbered 1, 2, 3, 4, 5, 6, 7, 8, 11 and 12 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 10, which is heavy If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 9, which is heavy If the pans balance then: Conclude that the counterfeit coin is number 11, which is heavy END If the pans balance then: BEGIN Put the coin numbered 12 on the left-hand pan Put the coin numbered 1 on the right-hand pan Leaving the coins numbered 2, 3, 4, 5, 6, 7, 8, 9, 10 and 11 on the table If the right-hand pan is heavier then: Conclude that the counterfeit coin is number 12, which is light If the left-hand pan is heavier then: Conclude that the counterfeit coin is number 12, which is heavy END END END </div> ---- 770a08cb7ab8270201e5bf4d79f14579dadb3093 0 10 208 172 2018-01-13T20:39:27Z John 2 /* adjacent( +Coordinate0, ?Coordinate1 ) */ wikitext text/x-wiki ;Constrained Permutations in Prolog __NOTOC__ Problem posted to [https://groups.google.com/forum/#!msg/comp.lang.prolog/e_-sEr4tuF4/gEEKXjLqhKkJ comp.lang.prolog] by Daniel Dudley ===Problem Statement=== <blockquote>A university was to hold an examination in 5 subjects: Norwegian, German, English, French and Spanish. In each of these languages there were 4 candidates. The examination room was therefore divided into 20 cells, as shown in the figure below (view this in a fixed font): <pre class="prolog">figure( [ " X ", " XXXXX", " XXXX ", " XXXX ", "XXXXX ", " X " ] ).</pre> The university's administration wanted to secure themselves against cheating. Candidates in the same language were to be completely isolated from each other - so much so that their cells were not to coincide even at the corners. A young lecturer was given the job of finding a solution to the problem, which he did, and justly received a pat on the back from the dean. Now it just so happens that the dean is an ardent prolog programmer in his spare time (how else could he make dean?) and, realizing that there could be several solutions to the problem, used his skills to find all solutions. Can you do the same? </blockquote> ===Note=== &ldquo;Several solutions&rdquo; doesn't really cover it! Assuming that by &lsquo;a solution&rsquo; we mean finding a mapping between candidates and cells, then, having found one such solution, we can easily find 955,514,879 other members of its solution &ldquo;family&rdquo; through: * ''candidate permutation'': There are (4!)⁵ permutations of the candidates within the cells allocated to their subjects; * ''subject permutation'': we can multiply the candidate permutations by the 5! permutations of the subjects allocated to particular sets of cells. This means that the total number of solutions is 955514880 &times; D where D is the number of solution families i.e. solutions that cannot be derived from each other by candidate or subject permutation. Finding [[#Result|D]] is the more interesting problem solved by this program. ====nut1( ?Solutions )==== <var>Solutions</var> is the number of distinct solutions to the subject/cell allocation problem for any five different subjects. <pre class="prolog">nut1( Solutions ) :- Norwegian = 1, German = 2, English = 3, French = 4, Spanish = 5, candidates( [Norwegian,German,English,French,Spanish], Candidates ), cells( Cells ), count_solutions( allocate(Cells,Candidates), Solutions ).</pre> ====allocate( +Cells, +Candidates )==== holds when each cell in <var>Cells</var> holds a candidate from <var>Candidates</var>. <pre class="prolog">allocate( Cells, Candidates ) :- allocation( Cells, 1, Candidates ).</pre> ====allocation( +Cells, +NextSubject, +Subjects )==== holds when <var>Cells</var> is a representation of a distinct solution to the subject/cell allocation problem. <var>NextSubject</var> is the highest subject that can be allocated next, while <var>Subjects</var> is the list of subjects needing allocation to <var>Cells</var>. Each subject is represented by a list, in which each occurrence of the subject number represents a candidate. We guarantee distinct solutions by ensuring that the allocation is made on the following basis: * For each subject: the location of the N+1th candidate must be a successor of the location of the Nth candidate - to eliminate candidate permutations. * The location of the first candidate of the N+1th subject must be a successor of the location of the first candidate of the Nth subject &ndash; to eliminate subject permutations. Operationally, at each step we select a candidate for a cell and constrain each of the cell's adjacent successors to have a different subject from it. <pre class="prolog">allocation( [], _Next, [] ). allocation( [Cell|Cells], Next, Subjects ) :- allocate_candidate( Subjects, Next, Candidate, Subjects1, Next1 ), cell( Candidate, Cell ), adjacent_successors( Cell, AdjacentSuccessors ), blocked( AdjacentSuccessors, Candidate ), allocation( Cells, Next1, Subjects1 ).</pre> ====allocate_candidate( +Subjects, +Next, ?Candidate, ?Subjects1, ?Next1 )==== holds when <var>Candidate</var> is taken from <var>Subjects</var> leaving <var>Subjects1</var>. <var>Candidate</var> is represented by a subject number &le; <var>Next</var>. <var>Next1</var> is the highest subject that can be allocated to the next cell, ensuring that the first candidate for each subject is allocated in order. <pre class="prolog">allocate_candidate( [Subject|Subjects], Next, Candidate, Subjects1, Next1 ) :- Subject = [Candidate|Candidates], Candidate =< Next, Next1 is max(Candidate+1,Next), residual_candidates( Candidates, Subjects, Subjects1 ). allocate_candidate( [Subject|Subjects], Next, Candidate, [Subject|Subjects1], Next1 ) :- Subject = [Candidate0|_Candidates], Candidate0 < Next, allocate_candidate( Subjects, Next, Candidate, Subjects1, Next1 ). residual_candidates( [], Subjects, Subjects ). residual_candidates( Candidates, Subjects, [Candidates|Subjects] ) :- Candidates = [_|_].</pre> ====cells( ?Layout )==== holds when <var>Layout</var> is a list of cells ordered by their row &times; column coordinates. Each cell is described by 5 binary digits, which indicate the subject assigned to it, and the set of successors of the cell that are adjacent to it. <pre class="prolog">cells( Layout ) :- findall( location_cell(Row,Column,_Cell), location(Row, Column), Cells ), sort( Cells, Ordered ), cells1( Ordered, Layout ). cells1( [], [] ). cells1( [location_cell(Row,Column,Cell)|Successors], [Cell|Matrix] ) :- adjacent_successors( Cell, AdjacentSuccessors ), cells2( Successors, Row, Column, AdjacentSuccessors ), cells1( Successors, Matrix ). cells2( [], _Row, _Column, [] ). cells2( [location_cell(Row1,Column1,Cell)|Layout], Row, Column, Adjacent ) :- ( adjacent( Row, Row1 ), adjacent( Column, Column1 ) -> Adjacent = [Cell|Adjacent1] ; otherwise -> Adjacent = Adjacent1 ), cells2( Layout, Row, Column, Adjacent1 ).</pre> ====location( ?Row, ?Column )==== holds when <var>Row</var> and <var>Column</var> are the (unary) row and column offsets of an "X" in <code>figure/1</code>. <pre class="prolog">location( Row, Column ) :- X is "X", figure( Drawing ), offset( Cells, Drawing, Row ), offset( X, Cells, Column ).</pre> ====cell( ?Subject, ?Cell )==== holds when <var>Cell</var> is the cell representation for <var>Subject</var>. <pre class="prolog">cell( 1, cell(1,0,0,0,0,_) ). cell( 2, cell(0,1,0,0,0,_) ). cell( 3, cell(0,0,1,0,0,_) ). cell( 4, cell(0,0,0,1,0,_) ). cell( 5, cell(0,0,0,0,1,_) ).</pre> ====block( ?Subject, ?Block )==== holds when <var>Block</var> is a cell representation that is incompatible with <var>Subject</var>. <pre class="prolog">block( 1, cell(0,_,_,_,_,_) ). block( 2, cell(_,0,_,_,_,_) ). block( 3, cell(_,_,0,_,_,_) ). block( 4, cell(_,_,_,0,_,_) ). block( 5, cell(_,_,_,_,0,_) ).</pre> ====adjacent_successors( ?Cell, ?AdjacentSuccesors )==== holds when <var>AdjacentSuccesors</var> is the set of successors of <var>Cell</var> that are adjacent to it. <pre class="prolog">adjacent_successors( cell(_,_,_,_,_,AdjacentSuccesors), AdjacentSuccesors ).</pre> ====blocked( +Blocked, ?Subject )==== holds when all the cells in <var>Blocked</var> are incompatible with <var>Subject</var>. <pre class="prolog">blocked( [], _Subject ). blocked( [Cell|Blocked], Subject ) :- block( Subject, Cell ), blocked( Blocked, Subject ).</pre> ====candidates( ?Subjects, ?Candidates )==== holds when there are 4 <var>Candidates</var> for each subject in <var>Subjects</var>. <pre class="prolog">candidates( [], [] ). candidates( [Subj|Subjects], [[Subj,Subj,Subj,Subj]|Candidates] ) :- candidates( Subjects, Candidates ).</pre> ====offset( +Element, +List, ?Offset )==== When <var>Element</var> has unary <var>Offset</var> from the head of <var>List</var>. <pre class="prolog">offset( Element, List, Position ) :- offset1( List, Element, 0, Position ). offset1( [Element|_Rest], Element, N, N ). offset1( [_Head|List], Element, N0, N ):- offset1( List, Element, s(N0), N ).</pre> ====adjacent( +Coordinate0, ?Coordinate1 )==== holds when <var>Coordinate0</var> and <var>Coordinate1</var> are the same or differ by 1. <pre class="prolog">adjacent( N, N ). adjacent( N, s(N) ). adjacent( s(N), N ).</pre> Load a small library of [[Puzzle Utilities]]. <pre class="prolog">:- ensure_loaded( misc ).</pre> The code is available as plain text [https://binding-time.co.uk/download/nut1.txt here]. === Result === This program reports '''29870''' solutions. c0df9d56cc865a5de36241e82d891c2e9688a5db 248 208 2021-09-23T22:37:55Z John 2 Updated the estimated number of solutions to account for rotational symmetry. wikitext text/x-wiki ;Constrained Permutations in Prolog __NOTOC__ Problem posted to [https://groups.google.com/forum/#!msg/comp.lang.prolog/e_-sEr4tuF4/gEEKXjLqhKkJ comp.lang.prolog] by Daniel Dudley ===Problem Statement=== <blockquote>A university was to hold an examination in 5 subjects: Norwegian, German, English, French and Spanish. In each of these languages there were 4 candidates. The examination room was therefore divided into 20 cells, as shown in the figure below (view this in a fixed font): <pre class="prolog">figure( [ " X ", " XXXXX", " XXXX ", " XXXX ", "XXXXX ", " X " ] ).</pre> The university's administration wanted to secure themselves against cheating. Candidates in the same language were to be completely isolated from each other - so much so that their cells were not to coincide even at the corners. A young lecturer was given the job of finding a solution to the problem, which he did, and justly received a pat on the back from the dean. Now it just so happens that the dean is an ardent prolog programmer in his spare time (how else could he make dean?) and, realizing that there could be several solutions to the problem, used his skills to find all solutions. Can you do the same? </blockquote> ===Note=== &ldquo;Several solutions&rdquo; doesn't really cover it! Assuming that by &lsquo;a solution&rsquo; we mean finding a mapping between candidates and cells, then, having found one such solution, we can easily find 238,878,719 other members of its solution &ldquo;family&rdquo; through: * ''candidate permutation'': There are (4!)⁵ permutations of the candidates within the cells allocated to their subjects; * ''subject permutation'': we can multiply the candidate permutations by the 5! permutations of the subjects allocated to particular sets of cells; * These are divided by the (4) degrees of rotational symmetry. This means that the total number of solutions is 238878720 &times; D where D is the number of solution families i.e. solutions that cannot be derived from each other by candidate or subject permutation. Finding [[#Result|D]] is the more interesting problem solved by this program. ====nut1( ?Solutions )==== <var>Solutions</var> is the number of distinct solutions to the subject/cell allocation problem for any five different subjects. <pre class="prolog">nut1( Solutions ) :- Norwegian = 1, German = 2, English = 3, French = 4, Spanish = 5, candidates( [Norwegian,German,English,French,Spanish], Candidates ), cells( Cells ), count_solutions( allocate(Cells,Candidates), Solutions ).</pre> ====allocate( +Cells, +Candidates )==== holds when each cell in <var>Cells</var> holds a candidate from <var>Candidates</var>. <pre class="prolog">allocate( Cells, Candidates ) :- allocation( Cells, 1, Candidates ).</pre> ====allocation( +Cells, +NextSubject, +Subjects )==== holds when <var>Cells</var> is a representation of a distinct solution to the subject/cell allocation problem. <var>NextSubject</var> is the highest subject that can be allocated next, while <var>Subjects</var> is the list of subjects needing allocation to <var>Cells</var>. Each subject is represented by a list, in which each occurrence of the subject number represents a candidate. We guarantee distinct solutions by ensuring that the allocation is made on the following basis: * For each subject: the location of the N+1th candidate must be a successor of the location of the Nth candidate - to eliminate candidate permutations. * The location of the first candidate of the N+1th subject must be a successor of the location of the first candidate of the Nth subject &ndash; to eliminate subject permutations. Operationally, at each step we select a candidate for a cell and constrain each of the cell's adjacent successors to have a different subject from it. <pre class="prolog">allocation( [], _Next, [] ). allocation( [Cell|Cells], Next, Subjects ) :- allocate_candidate( Subjects, Next, Candidate, Subjects1, Next1 ), cell( Candidate, Cell ), adjacent_successors( Cell, AdjacentSuccessors ), blocked( AdjacentSuccessors, Candidate ), allocation( Cells, Next1, Subjects1 ).</pre> ====allocate_candidate( +Subjects, +Next, ?Candidate, ?Subjects1, ?Next1 )==== holds when <var>Candidate</var> is taken from <var>Subjects</var> leaving <var>Subjects1</var>. <var>Candidate</var> is represented by a subject number &le; <var>Next</var>. <var>Next1</var> is the highest subject that can be allocated to the next cell, ensuring that the first candidate for each subject is allocated in order. <pre class="prolog">allocate_candidate( [Subject|Subjects], Next, Candidate, Subjects1, Next1 ) :- Subject = [Candidate|Candidates], Candidate =< Next, Next1 is max(Candidate+1,Next), residual_candidates( Candidates, Subjects, Subjects1 ). allocate_candidate( [Subject|Subjects], Next, Candidate, [Subject|Subjects1], Next1 ) :- Subject = [Candidate0|_Candidates], Candidate0 < Next, allocate_candidate( Subjects, Next, Candidate, Subjects1, Next1 ). residual_candidates( [], Subjects, Subjects ). residual_candidates( Candidates, Subjects, [Candidates|Subjects] ) :- Candidates = [_|_].</pre> ====cells( ?Layout )==== holds when <var>Layout</var> is a list of cells ordered by their row &times; column coordinates. Each cell is described by 5 binary digits, which indicate the subject assigned to it, and the set of successors of the cell that are adjacent to it. <pre class="prolog">cells( Layout ) :- findall( location_cell(Row,Column,_Cell), location(Row, Column), Cells ), sort( Cells, Ordered ), cells1( Ordered, Layout ). cells1( [], [] ). cells1( [location_cell(Row,Column,Cell)|Successors], [Cell|Matrix] ) :- adjacent_successors( Cell, AdjacentSuccessors ), cells2( Successors, Row, Column, AdjacentSuccessors ), cells1( Successors, Matrix ). cells2( [], _Row, _Column, [] ). cells2( [location_cell(Row1,Column1,Cell)|Layout], Row, Column, Adjacent ) :- ( adjacent( Row, Row1 ), adjacent( Column, Column1 ) -> Adjacent = [Cell|Adjacent1] ; otherwise -> Adjacent = Adjacent1 ), cells2( Layout, Row, Column, Adjacent1 ).</pre> ====location( ?Row, ?Column )==== holds when <var>Row</var> and <var>Column</var> are the (unary) row and column offsets of an "X" in <code>figure/1</code>. <pre class="prolog">location( Row, Column ) :- X is "X", figure( Drawing ), offset( Cells, Drawing, Row ), offset( X, Cells, Column ).</pre> ====cell( ?Subject, ?Cell )==== holds when <var>Cell</var> is the cell representation for <var>Subject</var>. <pre class="prolog">cell( 1, cell(1,0,0,0,0,_) ). cell( 2, cell(0,1,0,0,0,_) ). cell( 3, cell(0,0,1,0,0,_) ). cell( 4, cell(0,0,0,1,0,_) ). cell( 5, cell(0,0,0,0,1,_) ).</pre> ====block( ?Subject, ?Block )==== holds when <var>Block</var> is a cell representation that is incompatible with <var>Subject</var>. <pre class="prolog">block( 1, cell(0,_,_,_,_,_) ). block( 2, cell(_,0,_,_,_,_) ). block( 3, cell(_,_,0,_,_,_) ). block( 4, cell(_,_,_,0,_,_) ). block( 5, cell(_,_,_,_,0,_) ).</pre> ====adjacent_successors( ?Cell, ?AdjacentSuccesors )==== holds when <var>AdjacentSuccesors</var> is the set of successors of <var>Cell</var> that are adjacent to it. <pre class="prolog">adjacent_successors( cell(_,_,_,_,_,AdjacentSuccesors), AdjacentSuccesors ).</pre> ====blocked( +Blocked, ?Subject )==== holds when all the cells in <var>Blocked</var> are incompatible with <var>Subject</var>. <pre class="prolog">blocked( [], _Subject ). blocked( [Cell|Blocked], Subject ) :- block( Subject, Cell ), blocked( Blocked, Subject ).</pre> ====candidates( ?Subjects, ?Candidates )==== holds when there are 4 <var>Candidates</var> for each subject in <var>Subjects</var>. <pre class="prolog">candidates( [], [] ). candidates( [Subj|Subjects], [[Subj,Subj,Subj,Subj]|Candidates] ) :- candidates( Subjects, Candidates ).</pre> ====offset( +Element, +List, ?Offset )==== When <var>Element</var> has unary <var>Offset</var> from the head of <var>List</var>. <pre class="prolog">offset( Element, List, Position ) :- offset1( List, Element, 0, Position ). offset1( [Element|_Rest], Element, N, N ). offset1( [_Head|List], Element, N0, N ):- offset1( List, Element, s(N0), N ).</pre> ====adjacent( +Coordinate0, ?Coordinate1 )==== holds when <var>Coordinate0</var> and <var>Coordinate1</var> are the same or differ by 1. <pre class="prolog">adjacent( N, N ). adjacent( N, s(N) ). adjacent( s(N), N ).</pre> Load a small library of [[Puzzle Utilities]]. <pre class="prolog">:- ensure_loaded( misc ).</pre> The code is available as plain text [https://binding-time.co.uk/download/nut1.txt here]. === Result === This program reports '''29870''' solutions. bd687d0740fab748f5ad4d4b93321bf92704c82d 0 13 209 201 2018-01-13T20:43:31Z John 2 /* integer_sqrt( +N, ?Sqrt ) */ wikitext text/x-wiki __NOTOC__ Although this problem has a straightforward solution, it does demonstrate the value of thinking declaratively in understanding the problem, which relates to &ldquo;don't know&rdquo; nondeterminism, and an appropriate use of lemmas. == Problem: == [https://groups.google.com/forum/#!msg/de.comp.lang.java/xQ6T3kZGqcE/-OTNgyB8yxIJ Problem as posted to comp.lang.prolog] by Thorsten Seelend. Also known as Hans Freudenthal's [[wikipedia:Impossible Puzzle|Impossible Puzzle]]. <blockquote>Mister X thinks about two integers between 1 and 100 excluding: </blockquote> =====MISTERX: Two integers, X and Y between 2 and 99 (My formalization of the given information)===== <pre class="prolog">two_integers( X, Y ) :- between( 2, 98, X ), between( X, 99, Y ).</pre> He tells Susan the Sum of them and Peter their Product. Their task is to get the two original values without telling each other the numbers that Mister X told them. <blockquote>After some time Peter says: &ldquo;I can't say definitively which are the original numbers.&rdquo;</blockquote> =====PETER1: There is more than one pair of factors giving Product===== <pre class="prolog">property( peter1, Product ) :- \+ unique_factors( Product ).</pre> <blockquote>Then Susan responds: &ldquo;Neither can I, but I knew that you couldn't know it.&rdquo;</blockquote> =====SUSAN1: The product of ''every'' pair of summands giving Sum has the property PETER1===== <pre class="prolog">property( susan1, Sum ) :- forall( ordered_summands(Sum, X, Y), peter1(X * Y) ).</pre> <blockquote>Peter: &ldquo;Really? So now I know the original numbers&rdquo;.</blockquote> =====PETER2: ''exactly one'' pair of factors giving Product gives a sum with the property SUSAN1===== <pre class="prolog">property( peter2, Product ) :- unique_solution( (ordered_factors(Product, X, Y), susan1(X+Y)) ).</pre> <blockquote>Susan: &ldquo;Now I know them too&rdquo;.</blockquote> =====SUSAN2: ''exactly one'' pair of summands giving Sum has a product with the property PETER2===== <pre class="prolog">property( susan2, Sum ) :- unique_solution( (ordered_summands(Sum, X, Y), peter2(X * Y)) ).</pre> <blockquote>Question: What are the two numbers that Mister X thought of?</blockquote> =====Unique solution===== <pre class="prolog">solve( X, Y ) :- unique_solution( mister_x(X, Y) ). mister_x( X, Y ) :- two_integers( X, Y ), Sum is X + Y, Product is X * Y, peter1( Product ), susan1( Sum ), peter2( Product ), susan2( Sum ).</pre> == Macros == <pre class="prolog">peter1( Product ) :- lemma( peter1, Product ). peter2( Product ) :- lemma( peter2, Product ). susan1( Sum ) :- lemma( susan1, Sum ). susan2( Sum ) :- lemma( susan2, Sum ).</pre> == Lemmas == ====lemma( +Property, +Expression )==== holds wherever <var>Property</var> holds for <var>Expression</var>. Asserted facts are used to record successful (''positive'') or failed (''negative'') demonstrations. This saves recomputation without changing the meaning of the pure program. Although the use of side-effects is generally undesirable, the use of lemmas is justified when the alternative is to compromise performance or clarity. Using lemmas or tabling to cache results is an order of magnitude faster than recalculating each property every time it is used. <pre class="prolog">:- dynamic positive/2, negative/2. lemma( Name, Expression ) :- Value is Expression, ( positive( Value, Name ) -> true ; \+ negative( Value, Name ) -> ( property(Name, Value) -> assert( positive(Value, Name) ) ; otherwise -> assert( negative(Value, Name) ), fail ) ).</pre> == Supporting Predicates == ====ordered_summands( +Sum, ?X, ?Y )==== when <var>X</var> &le; <var>Y</var> and Sum = <var>X</var>+<var>Y</var>. NB: Since <var>X</var>&le;<var>Y</var> it follows that <var>X</var> &le; <var>Sum</var>/2. <pre class="prolog">ordered_summands( Z, X, Y ) :- Half is Z//2, between( 2, Half, X ), Y is Z - X, between( X, 98, Y ).</pre> ====ordered_factors( +Product, ?X, ?Y )==== when <var>X</var> &le; <var>Y</var> and <var>Product</var> = <var>X</var> &times; <var>Y</var>. NB: Since <var>X</var>&le;<var>Y</var> it follows that <var>X</var> &le; &radic;<var>Product</var>. <pre class="prolog">ordered_factors( Z, X, Y ) :- integer_sqrt( Z, SqrtZ ), between( 2, SqrtZ, X ), Y is Z // X, between( X, 99, Y ), Z =:= X * Y.</pre> ====unique_factors( +Product )==== when <var>Product</var> has exactly one pair of factors. <pre class="prolog">unique_factors( Product ) :- ordered_factors( Product, X, _Y ), \+ (ordered_factors(Product, X1, _Y1), X1 =\= X).</pre> ====integer_sqrt( +N, ?Sqrt )==== when <var>Sqrt</var>² &le; <var>N</var> &lt; (<var>Sqrt+1</var>)². <pre class="prolog">integer_sqrt( N, Sqrt ) :- Float is N * 1.0, sqrt( Float, FSqrt ), Sqrt is integer(FSqrt).</pre> Load a small library of [[Puzzle Utilities]]. <pre class="prolog">:- ensure_loaded( misc ).</pre> The code is available as plain text [https://binding-time.co.uk/download/mister_x.txt here]. == Result == This program finds X and Y as '''4''' and '''13'''. == Tabling == Using tabling, rather than explicit lemmas, can simplify code. [https://binding-time.co.uk/download/xsb_mister_x.txt A version adapted for XSB Prolog is available here.] 9c23ab3f8692dd506ff8609d9af1cd1424649dad 210 209 2018-01-13T20:44:11Z John 2 /* Tabling */ wikitext text/x-wiki __NOTOC__ Although this problem has a straightforward solution, it does demonstrate the value of thinking declaratively in understanding the problem, which relates to &ldquo;don't know&rdquo; nondeterminism, and an appropriate use of lemmas. == Problem: == [https://groups.google.com/forum/#!msg/de.comp.lang.java/xQ6T3kZGqcE/-OTNgyB8yxIJ Problem as posted to comp.lang.prolog] by Thorsten Seelend. Also known as Hans Freudenthal's [[wikipedia:Impossible Puzzle|Impossible Puzzle]]. <blockquote>Mister X thinks about two integers between 1 and 100 excluding: </blockquote> =====MISTERX: Two integers, X and Y between 2 and 99 (My formalization of the given information)===== <pre class="prolog">two_integers( X, Y ) :- between( 2, 98, X ), between( X, 99, Y ).</pre> He tells Susan the Sum of them and Peter their Product. Their task is to get the two original values without telling each other the numbers that Mister X told them. <blockquote>After some time Peter says: &ldquo;I can't say definitively which are the original numbers.&rdquo;</blockquote> =====PETER1: There is more than one pair of factors giving Product===== <pre class="prolog">property( peter1, Product ) :- \+ unique_factors( Product ).</pre> <blockquote>Then Susan responds: &ldquo;Neither can I, but I knew that you couldn't know it.&rdquo;</blockquote> =====SUSAN1: The product of ''every'' pair of summands giving Sum has the property PETER1===== <pre class="prolog">property( susan1, Sum ) :- forall( ordered_summands(Sum, X, Y), peter1(X * Y) ).</pre> <blockquote>Peter: &ldquo;Really? So now I know the original numbers&rdquo;.</blockquote> =====PETER2: ''exactly one'' pair of factors giving Product gives a sum with the property SUSAN1===== <pre class="prolog">property( peter2, Product ) :- unique_solution( (ordered_factors(Product, X, Y), susan1(X+Y)) ).</pre> <blockquote>Susan: &ldquo;Now I know them too&rdquo;.</blockquote> =====SUSAN2: ''exactly one'' pair of summands giving Sum has a product with the property PETER2===== <pre class="prolog">property( susan2, Sum ) :- unique_solution( (ordered_summands(Sum, X, Y), peter2(X * Y)) ).</pre> <blockquote>Question: What are the two numbers that Mister X thought of?</blockquote> =====Unique solution===== <pre class="prolog">solve( X, Y ) :- unique_solution( mister_x(X, Y) ). mister_x( X, Y ) :- two_integers( X, Y ), Sum is X + Y, Product is X * Y, peter1( Product ), susan1( Sum ), peter2( Product ), susan2( Sum ).</pre> == Macros == <pre class="prolog">peter1( Product ) :- lemma( peter1, Product ). peter2( Product ) :- lemma( peter2, Product ). susan1( Sum ) :- lemma( susan1, Sum ). susan2( Sum ) :- lemma( susan2, Sum ).</pre> == Lemmas == ====lemma( +Property, +Expression )==== holds wherever <var>Property</var> holds for <var>Expression</var>. Asserted facts are used to record successful (''positive'') or failed (''negative'') demonstrations. This saves recomputation without changing the meaning of the pure program. Although the use of side-effects is generally undesirable, the use of lemmas is justified when the alternative is to compromise performance or clarity. Using lemmas or tabling to cache results is an order of magnitude faster than recalculating each property every time it is used. <pre class="prolog">:- dynamic positive/2, negative/2. lemma( Name, Expression ) :- Value is Expression, ( positive( Value, Name ) -> true ; \+ negative( Value, Name ) -> ( property(Name, Value) -> assert( positive(Value, Name) ) ; otherwise -> assert( negative(Value, Name) ), fail ) ).</pre> == Supporting Predicates == ====ordered_summands( +Sum, ?X, ?Y )==== when <var>X</var> &le; <var>Y</var> and Sum = <var>X</var>+<var>Y</var>. NB: Since <var>X</var>&le;<var>Y</var> it follows that <var>X</var> &le; <var>Sum</var>/2. <pre class="prolog">ordered_summands( Z, X, Y ) :- Half is Z//2, between( 2, Half, X ), Y is Z - X, between( X, 98, Y ).</pre> ====ordered_factors( +Product, ?X, ?Y )==== when <var>X</var> &le; <var>Y</var> and <var>Product</var> = <var>X</var> &times; <var>Y</var>. NB: Since <var>X</var>&le;<var>Y</var> it follows that <var>X</var> &le; &radic;<var>Product</var>. <pre class="prolog">ordered_factors( Z, X, Y ) :- integer_sqrt( Z, SqrtZ ), between( 2, SqrtZ, X ), Y is Z // X, between( X, 99, Y ), Z =:= X * Y.</pre> ====unique_factors( +Product )==== when <var>Product</var> has exactly one pair of factors. <pre class="prolog">unique_factors( Product ) :- ordered_factors( Product, X, _Y ), \+ (ordered_factors(Product, X1, _Y1), X1 =\= X).</pre> ====integer_sqrt( +N, ?Sqrt )==== when <var>Sqrt</var>² &le; <var>N</var> &lt; (<var>Sqrt+1</var>)². <pre class="prolog">integer_sqrt( N, Sqrt ) :- Float is N * 1.0, sqrt( Float, FSqrt ), Sqrt is integer(FSqrt).</pre> Load a small library of [[Puzzle Utilities]]. <pre class="prolog">:- ensure_loaded( misc ).</pre> The code is available as plain text [https://binding-time.co.uk/download/mister_x.txt here]. == Result == This program finds X and Y as '''4''' and '''13'''. == Tabling == Using tabling, rather than explicit lemmas, can simplify code. [https://binding-time.co.uk/download/xsb_mister_x.txt A version adapted for XSB Prolog is available here.] fea06c3a2f28ed9dc9620488688fd037a0bf2621 213 210 2018-01-20T23:56:54Z John 2 /* integer_sqrt( +N, ?Sqrt ) */ wikitext text/x-wiki __NOTOC__ Although this problem has a straightforward solution, it does demonstrate the value of thinking declaratively in understanding the problem, which relates to &ldquo;don't know&rdquo; nondeterminism, and an appropriate use of lemmas. == Problem: == [https://groups.google.com/forum/#!msg/de.comp.lang.java/xQ6T3kZGqcE/-OTNgyB8yxIJ Problem as posted to comp.lang.prolog] by Thorsten Seelend. Also known as Hans Freudenthal's [[wikipedia:Impossible Puzzle|Impossible Puzzle]]. <blockquote>Mister X thinks about two integers between 1 and 100 excluding: </blockquote> =====MISTERX: Two integers, X and Y between 2 and 99 (My formalization of the given information)===== <pre class="prolog">two_integers( X, Y ) :- between( 2, 98, X ), between( X, 99, Y ).</pre> He tells Susan the Sum of them and Peter their Product. Their task is to get the two original values without telling each other the numbers that Mister X told them. <blockquote>After some time Peter says: &ldquo;I can't say definitively which are the original numbers.&rdquo;</blockquote> =====PETER1: There is more than one pair of factors giving Product===== <pre class="prolog">property( peter1, Product ) :- \+ unique_factors( Product ).</pre> <blockquote>Then Susan responds: &ldquo;Neither can I, but I knew that you couldn't know it.&rdquo;</blockquote> =====SUSAN1: The product of ''every'' pair of summands giving Sum has the property PETER1===== <pre class="prolog">property( susan1, Sum ) :- forall( ordered_summands(Sum, X, Y), peter1(X * Y) ).</pre> <blockquote>Peter: &ldquo;Really? So now I know the original numbers&rdquo;.</blockquote> =====PETER2: ''exactly one'' pair of factors giving Product gives a sum with the property SUSAN1===== <pre class="prolog">property( peter2, Product ) :- unique_solution( (ordered_factors(Product, X, Y), susan1(X+Y)) ).</pre> <blockquote>Susan: &ldquo;Now I know them too&rdquo;.</blockquote> =====SUSAN2: ''exactly one'' pair of summands giving Sum has a product with the property PETER2===== <pre class="prolog">property( susan2, Sum ) :- unique_solution( (ordered_summands(Sum, X, Y), peter2(X * Y)) ).</pre> <blockquote>Question: What are the two numbers that Mister X thought of?</blockquote> =====Unique solution===== <pre class="prolog">solve( X, Y ) :- unique_solution( mister_x(X, Y) ). mister_x( X, Y ) :- two_integers( X, Y ), Sum is X + Y, Product is X * Y, peter1( Product ), susan1( Sum ), peter2( Product ), susan2( Sum ).</pre> == Macros == <pre class="prolog">peter1( Product ) :- lemma( peter1, Product ). peter2( Product ) :- lemma( peter2, Product ). susan1( Sum ) :- lemma( susan1, Sum ). susan2( Sum ) :- lemma( susan2, Sum ).</pre> == Lemmas == ====lemma( +Property, +Expression )==== holds wherever <var>Property</var> holds for <var>Expression</var>. Asserted facts are used to record successful (''positive'') or failed (''negative'') demonstrations. This saves recomputation without changing the meaning of the pure program. Although the use of side-effects is generally undesirable, the use of lemmas is justified when the alternative is to compromise performance or clarity. Using lemmas or tabling to cache results is an order of magnitude faster than recalculating each property every time it is used. <pre class="prolog">:- dynamic positive/2, negative/2. lemma( Name, Expression ) :- Value is Expression, ( positive( Value, Name ) -> true ; \+ negative( Value, Name ) -> ( property(Name, Value) -> assert( positive(Value, Name) ) ; otherwise -> assert( negative(Value, Name) ), fail ) ).</pre> == Supporting Predicates == ====ordered_summands( +Sum, ?X, ?Y )==== when <var>X</var> &le; <var>Y</var> and Sum = <var>X</var>+<var>Y</var>. NB: Since <var>X</var>&le;<var>Y</var> it follows that <var>X</var> &le; <var>Sum</var>/2. <pre class="prolog">ordered_summands( Z, X, Y ) :- Half is Z//2, between( 2, Half, X ), Y is Z - X, between( X, 98, Y ).</pre> ====ordered_factors( +Product, ?X, ?Y )==== when <var>X</var> &le; <var>Y</var> and <var>Product</var> = <var>X</var> &times; <var>Y</var>. NB: Since <var>X</var>&le;<var>Y</var> it follows that <var>X</var> &le; &radic;<var>Product</var>. <pre class="prolog">ordered_factors( Z, X, Y ) :- integer_sqrt( Z, SqrtZ ), between( 2, SqrtZ, X ), Y is Z // X, between( X, 99, Y ), Z =:= X * Y.</pre> ====unique_factors( +Product )==== when <var>Product</var> has exactly one pair of factors. <pre class="prolog">unique_factors( Product ) :- ordered_factors( Product, X, _Y ), \+ (ordered_factors(Product, X1, _Y1), X1 =\= X).</pre> ====integer_sqrt( +N, ?Sqrt )==== when <var>Sqrt</var>² &le; <var>N</var> &lt; (<var>Sqrt</var>+1)². <pre class="prolog">integer_sqrt( N, Sqrt ) :- Float is N * 1.0, sqrt( Float, FSqrt ), Sqrt is integer(FSqrt).</pre> Load a small library of [[Puzzle Utilities]]. <pre class="prolog">:- ensure_loaded( misc ).</pre> The code is available as plain text [https://binding-time.co.uk/download/mister_x.txt here]. == Result == This program finds X and Y as '''4''' and '''13'''. == Tabling == Using tabling, rather than explicit lemmas, can simplify code. [https://binding-time.co.uk/download/xsb_mister_x.txt A version adapted for XSB Prolog is available here.] f2cbe7908c7bf650080871f4c20301460ad0188c 0 14 211 195 2018-01-13T20:45:28Z John 2 /* print_zoom_tracks( +ZoomTracks ) */ wikitext text/x-wiki __NOTOC__ <blockquote>Problem posted to [https://groups.google.com/forum/#!msg/comp.lang.prolog/kPfXFcAIBTk/0gYRo84wkSYJ comp.lang.prolog] by Paul Nothman: &ldquo;This problem was recently in a Mathematics competition. Although I completed it through logic and mathematics, without the aid of a computer, I'm wondering if and how it could be answered using prolog.&rdquo; </blockquote> == Problem Statement == The problem is as follows: World theme park has seven attractions which are so far apart that there needs to be a network of monorails, called zoomtracks, to transport the patrons between attractions. There is exactly one zoomtrack between each pair of attractions. Each zoomtrack can only transport patrons in one direction. The network is constructed so that two friends can always meet at a third attraction after exactly one trip each from any two attractions. Hint: Each attraction leads to and is led to by 3 other attractions. There are 21 zoomtracks altogether. Find the entire configuration of the theme park given the following: (The first letter of each line is the attraction from which the zoomtrack comes and the one beside it is where the zoomtrack leads to). SU SO ST UO UN UP OT ON NP TU == Solution Overview == An interesting aspect of this puzzle is the given partial solution. What is its purpose? Is it supposed to help or hinder? In fact, the partial solution allows relatively naive methods to find the right answer in reasonable time. However, I've chosen to implement a method that is not dependent on the partial solution. The key to this approach is the generation of the ''stations'' data-structures, which '''may''' be partially instantiated with the given solution, before the search for a complete solution begins. The requirements of the problem are that each attraction will have three destinations that can be reached by a single zoomtrack, and that every pair of attractions must have a destination in common. This solution uses the insight that every pair of attractions must have '''exactly one''' destination in common. ====zoom==== finds a solution and then prints it. <pre class="prolog">zoom :- zoom_tracks( ZoomTracks ), print_zoom_tracks( ZoomTracks ).</pre> ====zoom_tracks( ?ZoomTracks )==== holds when <var>ZoomTracks</var> is a set of Attraction × Links × Destinations tuples, describing a valid configuration of zoomtracks, such that each pair of attractions has exactly one destination in common. The predicate network/2 always generates viable solutions, but a simple assertion is used to demonstrate that the solution is valid directly. <pre class="prolog">zoom_tracks( ZoomTracks ) :- station_origin( Station, Attraction ), station_destinations( Station, Destinations ), length( Destinations, 3 ), findall( Station, attraction( Attraction ), ZoomTracks ), findall( [Dest,Dest,Dest], attraction( Dest ), PossibleDestinations ), unified_zoomtracks( ZoomTracks ), connections( ZoomTracks ), network( ZoomTracks, PossibleDestinations ), forall( pair_of_stations( ZoomTracks, Station1, Station2 ), friends_can_meet( Station1, Station2 ) ).</pre> ====unified_zoomtracks( +ZoomTracks )==== holds when <var>ZoomTracks</var> is a set of Attraction × Links × Destinations tuples such that each link between two Attractions is represented by a variable shared between the two attractions. In each tuple, the Link variable denoting the Attraction is bound to 'self'. <pre class="prolog">unified_zoomtracks( ZoomTracks ) :- station_origin( First, Attraction1 ), station_origin( Second, Attraction2 ), findall( Attraction1-Attraction2, pair_of_stations(ZoomTracks, First, Second), Linkage ), unified_links( Linkage, ZoomTracks ).</pre> ====unified_links( +Linkage, +ZoomTracks )==== holds when <var>Linkage</var> is a list of Attraction1-Attraction2 pairs such that in <var>ZoomTracks</var>: * The link variables denoting Attraction1 for Attraction2 and vice versa are unified. * The link variables denoting Attraction1 for Attraction1 and Attraction2 for Attraction2 are bound to 'self'. <pre class="prolog">unified_links( [], _ZoomTracks ). unified_links( [First-Second|Linkage], ZoomTracks ) :- station_origin( Station1, First ), station_links( Station1, Links1 ), station_origin( Station2, Second ), station_links( Station2, Links2 ), memberchk( Station1, ZoomTracks ), memberchk( Station2, ZoomTracks ), link_receiver( First, Links2, Receiver ), link_receiver( Second, Links1, Receiver ), link_receiver( First, Links1, self ), link_receiver( Second, Links2, self ), unified_links( Linkage, ZoomTracks ).</pre> ====connections( ?ZoomTracks )==== holds when the given connections have been applied to <var>ZoomTracks</var>. Note that this can be made vacuous without any significant effect on performance. <pre class="prolog">connections( ZoomTracks ) :- connection( s, u, ZoomTracks ), connection( s, o, ZoomTracks ), connection( s, t, ZoomTracks ), connection( u, o, ZoomTracks ), connection( u, n, ZoomTracks ), connection( u, p, ZoomTracks ), connection( o, t, ZoomTracks ), connection( o, n, ZoomTracks ), connection( n, p, ZoomTracks ), connection( t, u, ZoomTracks ).</pre> ====connection( +Source, +Destination, +ZoomTracks )==== holds when <var>ZoomTracks</var> contains a connection from <var>Source</var> to <var>Destination</var>. <pre class="prolog">connection( From, To, ZoomTracks ) :- station_origin( Station, From ), station_links( Station, Links ), station_destinations( Station, Destinations ), memberchk( Station, ZoomTracks ), memberchk( To, Destinations ), link_receiver( To, Links, To ).</pre> ====pair_of_stations( +ZoomTracks, ?Station1, ?Station2 )==== holds when <var>Station1</var> and <var>Station2</var> are distinct elements of <var>ZoomTracks</var>, avoiding redundant solutions. <pre class="prolog">pair_of_stations( [Station1|ZoomTracks], Station1, Station2 ) :- member( Station2, ZoomTracks ). pair_of_stations( [_Station0|ZoomTracks], Station1, Station2 ) :- pair_of_stations( ZoomTracks, Station1, Station2 ).</pre> ====friends_can_meet( +Station1, +Station2 )==== holds when <var>Station1</var> and <var>Station2</var> have a common destination. <pre class="prolog">friends_can_meet( Station1, Station2 ) :- station_destinations( Station1, Destinations1 ), station_destinations( Station2, Destinations2 ), member( MeetingPoint, Destinations1 ), member( MeetingPoint, Destinations2 ).</pre> ====network( +ZoomTracks, ?Destinations )==== holds when <var>ZoomTracks</var> is a set of Attraction &rarr; Destinations pairs describing a valid configuration of zoomtracks, such that each pair of attractions has exactly one destination in common. <var>Destinations</var> define the range of <var>ZoomTracks</var>. <pre class="prolog">network( ZoomTracks, Destinations ) :- network1( ZoomTracks, Destinations, [] ). network1( [], Destinations, _Stations ) :- forall( member( Empty, Destinations ), Empty == [] ). network1( [Station|Stations], Destinations, Assigned ) :- destination_assignment( Station, Destinations, Destinations1 ), properly_connected( Station, Assigned ), network1( Stations, Destinations1, [Station|Assigned] ).</pre> ====destination_assignment( +Station, +Destinations, ?Destinations1 )==== holds when <var>Destinations1</var> is the difference of <var>Destinations</var> and the destinations of <var>Station</var>, which must not contain the origin of <var>Station</var>. <pre class="prolog">destination_assignment( Station, Destinations0, Destinations1 ) :- station_destinations( Station, Destinations ), station_links( Station, Links ), matching( Destinations, Links, Destinations0, Destinations1 ).</pre> ====matching( +Destinations0, +Links, +Destinations1, ?Destinations2 )==== holds when <var>Destinations2</var> is the difference of <var>Destinations0</var> and <var>Destinations1</var>, and the <var>Links</var> variables corresponding to <var>Destinations0</var> are instantiated. <pre class="prolog">matching( [], _Links, Destinations, Destinations ). matching( [Destination|Destinations], Links, Destinations0, [Rest|Destinations1] ) :- select( [Destination|Rest], Destinations0, Destinations2 ), link_receiver( Destination, Links, Destination ), matching( Destinations, Links, Destinations2, Destinations1 ).</pre> ====properly_connected( +Station, +Stations )==== holds when <var>Station</var> and each member of <var>Stations</var> have exactly one destination in common. <pre class="prolog">properly_connected( Station, Stations ) :- station_destinations( Station, Destinations ), station_destinations( Station1, Destinations1 ), forall( member( Station1, Stations ), one_common_member( Destinations, Destinations1 ) ).</pre> ====one_common_member( ?Set0, ?Set1 )==== holds when <var>Set0</var> and <var>Set1</var> have exactly one common member. <pre class="prolog">one_common_member( Set0, Set1 ) :- select( Member, Set0, Residue0 ), select( Member, Set1, Residue1 ), \+ common_member( Residue0, Residue1 ).</pre> ====common_member( ?Set0, ?Set1 )==== holds when <var>Set0</var> and <var>Set1</var> have a common member. <pre class="prolog">common_member( Set0, Set1 ) :- member( Member, Set0 ), member( Member, Set1 ).</pre> === Data Abstraction === <pre class="prolog">attraction( Name ) :- link_receiver( Name, _Links, _Value ). link_receiver( s, links( S,_U,_O,_N,_T,_P,_Q), S ). link_receiver( u, links(_S, U,_O,_N,_T,_P,_Q), U ). link_receiver( o, links(_S,_U, O,_N,_T,_P,_Q), O ). link_receiver( n, links(_S,_U,_O, N,_T,_P,_Q), N ). link_receiver( t, links(_S,_U,_O,_N, T,_P,_Q), T ). link_receiver( p, links(_S,_U,_O,_N,_T ,P,_Q), P ). link_receiver( q, links(_S,_U,_O,_N,_T,_P, Q), Q ). station_destinations( zoom(_Name, _Links, Destinations), Destinations ). station_links( zoom(_Name, Links, _Destinations), Links ). station_origin( zoom(Name, _Links, _Destinations), Name ).</pre> ==Utility Predicates== Load a small library of [[Puzzle Utilities]]. <pre class="prolog">:- ensure_loaded( misc ).</pre> ====print_zoom_tracks( +ZoomTracks )==== prints all the links in <var>ZoomTracks</var> as origin - destination pairs of stations. <pre class="prolog">print_zoom_tracks( [] ). print_zoom_tracks( [ZoomTrack|ZoomTracks] ) :- station_origin( ZoomTrack, Origin ), station_destinations( ZoomTrack, Destinations ), print_zoom_track_links( Destinations, Origin ), print_zoom_tracks( ZoomTracks ). print_zoom_track_links( [], _Origin ). print_zoom_track_links( [Destination|Destinations], Origin ) :- write( Origin ), write( Destination ), nl, print_zoom_track_links( Destinations, Origin ).</pre> The code is available as plain text [https://binding-time.co.uk/download/zoom_tracks.txt here]. ==Result== <pre class="Result">| ?- zoom. su so st uo un up ot on oq np nt ns tu tp tq pq ps po qs qu qn yes</pre> 9fa89ca27f2f12dc71ea8fe2aaa3ba0f766fcffd 0 12 212 196 2018-01-13T21:56:28Z John 2 /* get_chars( ?Chars ) */ wikitext text/x-wiki The following predicates are used in the puzzle solutions. ==Higher-order Predicates== ====unique_solution( +Goal )==== holds when <var>Goal</var> has one ground solution. Operationally, <var>Goal</var> may produce several solutions, ("don't care" non-deterministically), but they must all be identical (<code>==</code>). <pre class="prolog">unique_solution( Goal ) :- findall( Goal, Goal, [Solution|Solutions] ), same_solution( Solutions, Solution ), Solution = Goal. same_solution( [], _Solution ). same_solution( [Solution0|Solutions], Solution ) :- Solution0 == Solution, same_solution( Solutions, Solution ).</pre> ====forall( +Enumerator, +Test )==== is true if <var>Enumerator</var> and <var>Test</var> are goals and <var>Test</var> holds everywhere that <var>Enumerator</var> does. NB: forall/2 does not instantiate arguments further. <pre class="prolog">forall( Enumerator, Test ) :- \+ (call(Enumerator), \+ call(Test)).</pre> ====count_solutions( +Goal, ?Count )==== is true if <var>Count</var> is the number of solutions for <var>Goal</var>. The solutions might not be distinct. <code>count_solutions/2</code> enumerates the possible solutions to <var>Goal</var> but does not instantiate <var>Goal</var>'s arguments further. <pre class="prolog"> count_solutions( Goal, Count ) :- findall( x, Goal, Xs ), length( Xs, Count ). </pre> ==Lists== ====member( ?Element, ?List )==== holds when <var>Element</var> is a member of <var>List</var>. <pre class="prolog">member( H, [H|_] ). member( H, [_|T] ) :- member( H, T ).</pre> ====select( ?Element, ?List0, ?List1 )==== is true if <var>List1</var> is equal to <var>List0</var> with <var>Element</var> removed. <pre class="prolog">select( H, [H|T], T ). select( Element, [H|T0], [H|T1] ) :- select( Element, T0, T1 ).</pre> ====memberchk( +Element, +List )==== succeeds (once) if <var>Element</var> is a member of <var>List</var>. <pre class="prolog">memberchk( Element, List ) :- member( Element, List ), !.</pre> ====append( ?Front, ?Back, ?List )==== succeeds if <var>Front</var>, <var>Back</var> and <var>List</var> are all lists and <var>List</var> is the concatenation of <var>Front</var> and <var>Back</var>. <pre class="prolog">append( [], L, L ). append( [H|T], L, [H|L1] ) :- append( T, L, L1 ). </pre> ====length( ?List, ?N )==== succeeds if <var>N</var> is the length of <var>List</var>. <pre class="prolog">length( List, N ) :- len1( List, 0, N ). len1( [], N, N ). len1( [_H|T], N0, N ) :- N1 is N0+1, len1( T, N1, N ). </pre> ==Arithmetic== ====between( +Lower, +Upper, ?Index )==== is true if <var>Lower</var> =< <var>Index</var> =< <var>Upper</var>. Two valid cases are possible: * <var>Index</var> is already instantiated to an integer, so the checks on order are applied (test). * <var>Index</var> is a logical variable: a series of alternative solutions may be generated as the monotonic sequence of values between <var>Lower</var> and <var>Upper</var> (non-deterministic generator). <pre class="prolog">between( Lower, Upper, Index ) :- integer( Lower ), integer( Upper ), Lower =< Upper, ( integer( Index ) -> % Case 1: "test" Index >= Lower, Index =< Upper ; var( Index ) -> % Case 2: "generate". generate_between( Lower, Upper, Index ) ). generate_between( Lower, Upper, Index ) :- ( Lower =:= Upper -> Index = Lower ; Index = Lower ; Next is Lower + 1, Next =< Upper, generate_between( Next, Upper, Index ) ).</pre> ====sum( +List, ?Sum )==== holds when the <var>List</var> of numbers sum to <var>Sum</var>. <pre class="prolog">sum( [H|T], Sum ) :- sum1( T, H, Sum ). sum1( [], Sum, Sum ). sum1( [H|T], Sum0, Sum ):- Sum1 is Sum0 + H, sum1( T, Sum1, Sum ).</pre> ==Character Input/Output== ====put_chars( +Chars )==== if <var>Chars</var> is a (possibly empty) list of character codes and the corresponding characters are written to the current output stream. <pre class="prolog">put_chars( [] ). put_chars( [Char|Chars] ) :- put( Char ), put_chars( Chars ).</pre> ====get_chars( ?Chars )==== if <var>Chars</var> is a (possibly empty) list of character codes read from the current input stream. <pre class="prolog">get_chars( Input ) :- get0( Char ), ( Char > -1 -> Input = [Char|Chars], get_chars( Chars ) ; otherwise -> Input = [] ).</pre> The code is available as plain text [https://binding-time.co.uk/download/misc.txt here]. a56a09ab817e807b0052d73a1a79a6afe2c372da 231 212 2019-07-21T20:05:39Z John 2 /* unique_solution( +Goal ) */ wikitext text/x-wiki The following predicates are used in the puzzle solutions. ==Higher-order Predicates== ====unique_solution( +Goal )==== holds when <var>Goal</var> has one ground solution. Operationally, <var>Goal</var> may produce several proofs of the solution, ("don't care" non-deterministically), but they must all be identical (<code>==</code>). <pre class="prolog">unique_solution( Goal ) :- findall( Goal, Goal, [Solution|Proofs] ), same_solution( Proofs, Solution ), Solution = Goal. same_solution( [], _Solution ). same_solution( [Proof|Proofs], Solution ) :- Proof == Solution, same_solution( Solutions, Solution ).</pre> ====forall( +Enumerator, +Test )==== is true if <var>Enumerator</var> and <var>Test</var> are goals and <var>Test</var> holds everywhere that <var>Enumerator</var> does. NB: forall/2 does not instantiate arguments further. <pre class="prolog">forall( Enumerator, Test ) :- \+ (call(Enumerator), \+ call(Test)).</pre> ====count_solutions( +Goal, ?Count )==== is true if <var>Count</var> is the number of solutions for <var>Goal</var>. The solutions might not be distinct. <code>count_solutions/2</code> enumerates the possible solutions to <var>Goal</var> but does not instantiate <var>Goal</var>'s arguments further. <pre class="prolog"> count_solutions( Goal, Count ) :- findall( x, Goal, Xs ), length( Xs, Count ). </pre> ==Lists== ====member( ?Element, ?List )==== holds when <var>Element</var> is a member of <var>List</var>. <pre class="prolog">member( H, [H|_] ). member( H, [_|T] ) :- member( H, T ).</pre> ====select( ?Element, ?List0, ?List1 )==== is true if <var>List1</var> is equal to <var>List0</var> with <var>Element</var> removed. <pre class="prolog">select( H, [H|T], T ). select( Element, [H|T0], [H|T1] ) :- select( Element, T0, T1 ).</pre> ====memberchk( +Element, +List )==== succeeds (once) if <var>Element</var> is a member of <var>List</var>. <pre class="prolog">memberchk( Element, List ) :- member( Element, List ), !.</pre> ====append( ?Front, ?Back, ?List )==== succeeds if <var>Front</var>, <var>Back</var> and <var>List</var> are all lists and <var>List</var> is the concatenation of <var>Front</var> and <var>Back</var>. <pre class="prolog">append( [], L, L ). append( [H|T], L, [H|L1] ) :- append( T, L, L1 ). </pre> ====length( ?List, ?N )==== succeeds if <var>N</var> is the length of <var>List</var>. <pre class="prolog">length( List, N ) :- len1( List, 0, N ). len1( [], N, N ). len1( [_H|T], N0, N ) :- N1 is N0+1, len1( T, N1, N ). </pre> ==Arithmetic== ====between( +Lower, +Upper, ?Index )==== is true if <var>Lower</var> =< <var>Index</var> =< <var>Upper</var>. Two valid cases are possible: * <var>Index</var> is already instantiated to an integer, so the checks on order are applied (test). * <var>Index</var> is a logical variable: a series of alternative solutions may be generated as the monotonic sequence of values between <var>Lower</var> and <var>Upper</var> (non-deterministic generator). <pre class="prolog">between( Lower, Upper, Index ) :- integer( Lower ), integer( Upper ), Lower =< Upper, ( integer( Index ) -> % Case 1: "test" Index >= Lower, Index =< Upper ; var( Index ) -> % Case 2: "generate". generate_between( Lower, Upper, Index ) ). generate_between( Lower, Upper, Index ) :- ( Lower =:= Upper -> Index = Lower ; Index = Lower ; Next is Lower + 1, Next =< Upper, generate_between( Next, Upper, Index ) ).</pre> ====sum( +List, ?Sum )==== holds when the <var>List</var> of numbers sum to <var>Sum</var>. <pre class="prolog">sum( [H|T], Sum ) :- sum1( T, H, Sum ). sum1( [], Sum, Sum ). sum1( [H|T], Sum0, Sum ):- Sum1 is Sum0 + H, sum1( T, Sum1, Sum ).</pre> ==Character Input/Output== ====put_chars( +Chars )==== if <var>Chars</var> is a (possibly empty) list of character codes and the corresponding characters are written to the current output stream. <pre class="prolog">put_chars( [] ). put_chars( [Char|Chars] ) :- put( Char ), put_chars( Chars ).</pre> ====get_chars( ?Chars )==== if <var>Chars</var> is a (possibly empty) list of character codes read from the current input stream. <pre class="prolog">get_chars( Input ) :- get0( Char ), ( Char > -1 -> Input = [Char|Chars], get_chars( Chars ) ; otherwise -> Input = [] ).</pre> The code is available as plain text [https://binding-time.co.uk/download/misc.txt here]. fe1db3b5be5e288b281eb0e50defe3ee6fd6b685 243 231 2020-04-05T18:36:12Z John 2 /* unique_solution( +Goal ) */ wikitext text/x-wiki The following predicates are used in the puzzle solutions. ==Higher-order Predicates== ====unique_solution( +Goal )==== holds when <var>Goal</var> has one ground solution. Operationally, <var>Goal</var> may produce several proofs of the solution, ("don't care" non-deterministically), but they must all be identical (<code>==</code>). <pre class="prolog">unique_solution( Goal ) :- findall( Goal, Goal, [Solution|Proofs] ), same_solution( Proofs, Solution ), Solution = Goal. same_solution( [], _Solution ). same_solution( [Proof|Proofs], Solution ) :- Proof == Solution, same_solution( Proofs, Solution ).</pre> ====forall( +Enumerator, +Test )==== is true if <var>Enumerator</var> and <var>Test</var> are goals and <var>Test</var> holds everywhere that <var>Enumerator</var> does. NB: forall/2 does not instantiate arguments further. <pre class="prolog">forall( Enumerator, Test ) :- \+ (call(Enumerator), \+ call(Test)).</pre> ====count_solutions( +Goal, ?Count )==== is true if <var>Count</var> is the number of solutions for <var>Goal</var>. The solutions might not be distinct. <code>count_solutions/2</code> enumerates the possible solutions to <var>Goal</var> but does not instantiate <var>Goal</var>'s arguments further. <pre class="prolog"> count_solutions( Goal, Count ) :- findall( x, Goal, Xs ), length( Xs, Count ). </pre> ==Lists== ====member( ?Element, ?List )==== holds when <var>Element</var> is a member of <var>List</var>. <pre class="prolog">member( H, [H|_] ). member( H, [_|T] ) :- member( H, T ).</pre> ====select( ?Element, ?List0, ?List1 )==== is true if <var>List1</var> is equal to <var>List0</var> with <var>Element</var> removed. <pre class="prolog">select( H, [H|T], T ). select( Element, [H|T0], [H|T1] ) :- select( Element, T0, T1 ).</pre> ====memberchk( +Element, +List )==== succeeds (once) if <var>Element</var> is a member of <var>List</var>. <pre class="prolog">memberchk( Element, List ) :- member( Element, List ), !.</pre> ====append( ?Front, ?Back, ?List )==== succeeds if <var>Front</var>, <var>Back</var> and <var>List</var> are all lists and <var>List</var> is the concatenation of <var>Front</var> and <var>Back</var>. <pre class="prolog">append( [], L, L ). append( [H|T], L, [H|L1] ) :- append( T, L, L1 ). </pre> ====length( ?List, ?N )==== succeeds if <var>N</var> is the length of <var>List</var>. <pre class="prolog">length( List, N ) :- len1( List, 0, N ). len1( [], N, N ). len1( [_H|T], N0, N ) :- N1 is N0+1, len1( T, N1, N ). </pre> ==Arithmetic== ====between( +Lower, +Upper, ?Index )==== is true if <var>Lower</var> =< <var>Index</var> =< <var>Upper</var>. Two valid cases are possible: * <var>Index</var> is already instantiated to an integer, so the checks on order are applied (test). * <var>Index</var> is a logical variable: a series of alternative solutions may be generated as the monotonic sequence of values between <var>Lower</var> and <var>Upper</var> (non-deterministic generator). <pre class="prolog">between( Lower, Upper, Index ) :- integer( Lower ), integer( Upper ), Lower =< Upper, ( integer( Index ) -> % Case 1: "test" Index >= Lower, Index =< Upper ; var( Index ) -> % Case 2: "generate". generate_between( Lower, Upper, Index ) ). generate_between( Lower, Upper, Index ) :- ( Lower =:= Upper -> Index = Lower ; Index = Lower ; Next is Lower + 1, Next =< Upper, generate_between( Next, Upper, Index ) ).</pre> ====sum( +List, ?Sum )==== holds when the <var>List</var> of numbers sum to <var>Sum</var>. <pre class="prolog">sum( [H|T], Sum ) :- sum1( T, H, Sum ). sum1( [], Sum, Sum ). sum1( [H|T], Sum0, Sum ):- Sum1 is Sum0 + H, sum1( T, Sum1, Sum ).</pre> ==Character Input/Output== ====put_chars( +Chars )==== if <var>Chars</var> is a (possibly empty) list of character codes and the corresponding characters are written to the current output stream. <pre class="prolog">put_chars( [] ). put_chars( [Char|Chars] ) :- put( Char ), put_chars( Chars ).</pre> ====get_chars( ?Chars )==== if <var>Chars</var> is a (possibly empty) list of character codes read from the current input stream. <pre class="prolog">get_chars( Input ) :- get0( Char ), ( Char > -1 -> Input = [Char|Chars], get_chars( Chars ) ; otherwise -> Input = [] ).</pre> The code is available as plain text [https://binding-time.co.uk/download/misc.txt here]. 86b3194ab4d5c4564207795d125715ce95e65181 0 16 214 193 2018-01-22T23:07:37Z John 2 Logtalk uses https now. wikitext text/x-wiki __NOTOC__ <blockquote> &ldquo;I have a hard time arguing that anything in XML is generically useful any more except for the basic syntax, which lets us apply some very handy low-level tools like parsers and XSLT. The rest (XLink, schemas, etc.) has been a pointless trip into complexity.&rdquo; <cite>[http://lists.w3.org/Archives/Public/www-tag/2002Sep/0303.html Simon St.Laurent]</cite> </blockquote> <blockquote> &ldquo;My own experience is that having Prolog, Scheme, and Haskell available it'll take a gun pointed at my head or an extremely large bribe to make me use XSLT for anything.&rdquo; <cite>[http://cliplab.org/Mail/ciao-users/2001/000207.html Richard A. O'Keefe]</cite> </blockquote> ==Background== xml.pl is a module for parsing XML with Prolog, which provides Prolog applications with a simple ''Document Value Model'' interface to XML documents. It has been used successfully in a number of applications. It supports a subset of XML suitable for XML Data and Worldwide Web applications but it is neither as strict nor as comprehensive as the [http://www.w3.org/TR/2000/REC-xml-20001006 XML 1.0 Specification] mandates. * It is not as strict because, while the specification must eliminate ambiguities, not all errors need to be regarded as faults, and some reasonable examples of real XML usage would have to be rejected if they were. * It is not as comprehensive because, where the XML specification makes provision for more or less complete DTDs to be provided as part of a document, xml.pl actions the local definition of ENTITIES only. Other DTD extensions are treated as commentary. ===Download the [[XML Module]] (xml.pl and plxml)=== xml.pl and plxml, a small Windows application which embodies xml.pl, have been placed into the public domain to encourage the use of Prolog with XML. I hope that they will be useful to you, but they are not supported, and they are provided without any warranty of any kind. ==Specification== Three predicates are exported by the module: <code>xml_parse/[2,3]</code>, <code>xml_subterm/2</code> and <code>xml_pp/1</code> . ====xml_parse( {+Controls,} +?Chars, ?+Document )==== parses <var>Chars</var>, a list of character codes, to/from <var>Document</var>, a data structure of the form <code>xml(Attributes, Content)</code>, where: ''Attributes'' is a list of ''Name''=''CharData'' attributes from the (possibly implicit) XML signature of the document. ''Content'' is a (possibly empty) list comprising occurrences of: ; <code>pcdata(CharData)</code> : Text ; <code>comment(CharData)</code> : An XML comment; ; <code>namespace(URI, Prefix, Element)</code> : a Namespace ; <code>element(Tag, Attributes, Content)</code> : <Tag>..</Tag> encloses Content or <Tag/> if Content is empty <nowiki>[]</nowiki>. ; <code>instructions(Name, CharData)</code> : A PI <?Name CharData?> ; <code>cdata(CharData)</code> : <![CDATA[CharData]]> ; <code>doctype(Tag, DoctypeId)</code> : DTD <!DOCTYPE .. > The conversions are not completely symmetrical in that weaker XML is accepted than can be generated. Specifically, in-bound ''(Chars -> Document)'' parsing does not require strictly well-formed XML. If <var>Chars</var> does not represent well-formed XML, <var>Document</var> is instantiated to the term <code>malformed(Attributes, Content)</code>. The ''Content'' of a ''malformed/2'' structure can include: ; <code>unparsed( CharData )</code> : Text which has not been parsed ; <code>out_of_context(Tag)</code> : <Tag> is not closed in addition to the parsed-term types. Out-bound ''(<var>Document</var> -> <var>Chars</var>)'' parsing ''does'' require that <var>Document</var> defines well-formed XML. If an error is detected, a 'domain' exception is raised. The domain exception will attempt to identify the particular sub-term in error, and will list the ancestor elements of the sub-term in error as <code>Tag{(Id)}</code> terms - where ''Id'' is the value of any attribute named id. The <var>Controls</var> applying to in-bound ''(<var>Chars</var> -> <var>Document</var>)'' parsing are: ; <code>extended_characters(Boolean)</code> : Use the extended character entities for XHTML (default true). ; <code>format(Boolean)</code> : Remove layouts when no non-layout character data appears between elements (default true). ; <code>remove_attribute_prefixes(Boolean)</code> : Remove redundant prefixes from attributes - i.e. prefixes denoting the namespace of the parent element (default false). ; <code> allow_ampersand(Boolean) </code> : Allow unescaped ampersand characters (&) to occur in PCDATA (default false). For out-bound ''(<var>Document</var> -> <var>Chars</var>)'' parsing, the only available option is: ; <code>format(Boolean)</code> : Indent the element content, (default true) ===Types=== ; Tag : An atom naming an element ; Name : An atom, not naming an element ; URI : An atom giving the URI of a Namespace ; CharData : A "string": list of character codes. ; DoctypeId : one of: <code>public(CharData,&nbsp;CharData&nbsp;{,&nbsp;DTDLiterals})</code>, <code>system(CharData&nbsp;{,&nbsp;DTDLiterals})</code> or <code>local{(DTDLiterals)}</code> ; DTDLiterals : A non-empty list of <code>dtd_literal(CharData)</code> terms - e.g. [http://www.w3.org/TR/2000/REC-xml-20001006#NT-AttlistDecl attribute-list declarations]. ; Boolean : one of <code>true</code> or <code>false</code> ====xml_subterm( +XMLTerm, ?Subterm )==== unifies <var>Subterm</var> with a sub-term of <var>XMLTerm</var>. This can be especially useful when trying to test or retrieve a deeply-nested subterm from a document, as demonstrated in the [[XML Query Use Cases with xml.pl]] examples. Note that <var>XMLTerm</var> is a sub-term of itself. ====xml_pp( +XMLDocument )==== "pretty prints" <var>XMLDocument</var> on the current output stream. ==Availability== On this site, you can download the [[XML Module]]. The module is also supplied as a library with the following Prologs: * It has been adapted for the [https://logtalk.org/ Logtalk Open source object-oriented extension to Prolog] by Paulo Moura. (See the folder "contributions/xml_parser" from release 2.29.1); * It is available in the [http://eclipseclp.org/ ECLiPSe Constraint Programming System], as a third-party library; * It has been ported to [http://www.picat-lang.org/bprolog/ B-Prolog] by Neng-Fa Zhou. * It has been adapted for [https://sicstus.sics.se/thirdparty.html SICStus Prolog] by Mats Carlsson. * It is included in [https://quintus.sics.se/ Quintus Prolog Release 3.5]. [[XML Query Use Cases with xml.pl]] provides examples of the ways that the code can be used. ==Features of xml.pl== The <code>xml/2</code> data structure has some useful properties. ===Reusability=== Using a native Prolog representation of XML, in which terms represent document 'nodes', makes the parser reusable for any XML application. In effect, xml.pl encapsulates the application-independent tasks of document parsing and generation, which is essential where documents have components from more than one Namespace. ===Same Structure=== The Prolog term representing a document has the same structure as the document itself, which makes the correspondence between the literal representation of the Prolog term and the XML source readily apparent. For example, this simple [http://www.w3.org/Graphics/SVG/ SVG] image: <pre class="xml"> <?xml version="1.0" standalone="no"?> <!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.0//EN" "http://www.w3.org/.../svg10.dtd" [ <!ENTITY redblue "fill: red; stroke: blue; stroke-width: 1"> ]> <svg xmlns="http://www.w3.org/2000/svg" width="500" height="500"> <circle cx=" 25 " cy=" 25 " r=" 24 " style="&redblue;"/> </svg> </pre> ... translates into this Prolog term: <pre class="prolog"> xml( [version="1.0", standalone="no"], [ doctype( svg, public( "-//W3C//DTD SVG 1.0//EN", "http://www.w3.org/.../svg10.dtd" ) ), namespace( 'http://www.w3.org/2000/svg', "", element( svg, [width="500", height="500"], [ element( circle, [cx="25", cy="25", r="24", style="fill: red; stroke: blue; stroke-width: 1"], [] ) ] ) ) ] ). </pre> ===Efficient Manipulation=== Each type of node in an XML document is represented by a different Prolog functor, while data, (PCDATA, CDATA and Attribute Values), are left as "strings", (lists of character codes). The use of distinct functors for mark-up structures enables the efficient recursive traversal of a document, while leaving the data as strings facilitates the application-specific parsing of data content (aka Micro-parsing). For example, to turn every CDATA node into a PCDATA node with tabs expanded into spaces: <pre class="prolog"> cdata_to_pcdata( cdata(CharsWithTabs), pcdata(CharsWithSpaces) ) :- tab_expansion( CharsWithTabs, CharsWithSpaces ). cdata_to_pcdata( xml(Attributes, Content1), xml(Attributes, Content2) ) :- cdata_to_pcdata( Content1, Content2 ). cdata_to_pcdata( namespace(URI,Pfx,Content1), namespace(URI,Pfx,Content2) ) :- cdata_to_pcdata( Content1, Content2 ). cdata_to_pcdata( element(Name,Atts,Content1), element(Name,Atts,Content2) ) :- cdata_to_pcdata( Content1, Content2 ). cdata_to_pcdata( [], [] ). cdata_to_pcdata( [H1|T1], [H2|T2] ) :- cdata_to_pcdata( H1, H2 ), cdata_to_pcdata( T1, T2 ). cdata_to_pcdata( pcdata(Chars), pcdata(Chars) ). cdata_to_pcdata( comment(Chars), comment(Chars) ). cdata_to_pcdata( instructions(Name, Chars), instructions(Name, Chars) ). cdata_to_pcdata( doctype(Tag, DoctypeId), doctype(Tag, DoctypeId) ). </pre> The above uses no 'cuts', but will not create any choice points with ground input. ===Elegance=== The resolution of entity references and the decomposition of the document into distinct nodes means that the calling application is not concerned with the occasionally messy syntax of XML documents. For example, the clean separation of namespace nodes means that Namespaces, which are useful in combining specifications developed separately, have similar usefulness in combining applications developed separately. 7be1e784d208c07baa82b572a8c9a803efc41df9 223 214 2018-06-18T23:24:30Z John 2 Updated link to R A O'Keefe's message on the Ciao mailing list. Latest Mediawiki can't cope with PI representation even when the literal characters or quoted. Poorly sanitized PHP? wikitext text/x-wiki __NOTOC__ <blockquote> &ldquo;I have a hard time arguing that anything in XML is generically useful any more except for the basic syntax, which lets us apply some very handy low-level tools like parsers and XSLT. The rest (XLink, schemas, etc.) has been a pointless trip into complexity.&rdquo; <cite>[http://lists.w3.org/Archives/Public/www-tag/2002Sep/0303.html Simon St.Laurent]</cite> </blockquote> <blockquote> &ldquo;My own experience is that having Prolog, Scheme, and Haskell available it'll take a gun pointed at my head or an extremely large bribe to make me use XSLT for anything.&rdquo; <cite>[http://cliplab.org/Mail/ciao-users/2001/000206.html Richard A. O'Keefe]</cite> </blockquote> ==Background== xml.pl is a module for parsing XML with Prolog, which provides Prolog applications with a simple ''Document Value Model'' interface to XML documents. It has been used successfully in a number of applications. It supports a subset of XML suitable for XML Data and Worldwide Web applications but it is neither as strict nor as comprehensive as the [http://www.w3.org/TR/2000/REC-xml-20001006 XML 1.0 Specification] mandates. * It is not as strict because, while the specification must eliminate ambiguities, not all errors need to be regarded as faults, and some reasonable examples of real XML usage would have to be rejected if they were. * It is not as comprehensive because, where the XML specification makes provision for more or less complete DTDs to be provided as part of a document, xml.pl actions the local definition of ENTITIES only. Other DTD extensions are treated as commentary. ===Download the [[XML Module]] (xml.pl and plxml)=== xml.pl and plxml, a small Windows application which embodies xml.pl, have been placed into the public domain to encourage the use of Prolog with XML. I hope that they will be useful to you, but they are not supported, and they are provided without any warranty of any kind. ==Specification== Three predicates are exported by the module: <code>xml_parse/[2,3]</code>, <code>xml_subterm/2</code> and <code>xml_pp/1</code> . ====xml_parse( {+Controls,} +?Chars, ?+Document )==== parses <var>Chars</var>, a list of character codes, to/from <var>Document</var>, a data structure of the form <code>xml(Attributes, Content)</code>, where: ''Attributes'' is a list of ''Name''=''CharData'' attributes from the (possibly implicit) XML signature of the document. ''Content'' is a (possibly empty) list comprising occurrences of: ; <code>pcdata(CharData)</code> : Text ; <code>instructions(Name, CharData)</code> : A Processing Instruction &lt ? Name CharData ? &gt;; ; <code>comment(CharData)</code> : An XML comment; ; <code>namespace(URI, Prefix, Element)</code> : a Namespace ; <code>element(Tag, Attributes, Content)</code> : <Tag>..</Tag> encloses Content or <Tag/> if Content is empty <nowiki>[]</nowiki>. ; <code>cdata(CharData)</code> : <![CDATA[CharData]]> ; <code>doctype(Tag, DoctypeId)</code> : DTD <!DOCTYPE .. > The conversions are not completely symmetrical in that weaker XML is accepted than can be generated. Specifically, in-bound ''(Chars -> Document)'' parsing does not require strictly well-formed XML. If <var>Chars</var> does not represent well-formed XML, <var>Document</var> is instantiated to the term <code>malformed(Attributes, Content)</code>. The ''Content'' of a ''malformed/2'' structure can include: ; <code>unparsed( CharData )</code> : Text which has not been parsed ; <code>out_of_context(Tag)</code> : <Tag> is not closed in addition to the parsed-term types. Out-bound ''(<var>Document</var> -> <var>Chars</var>)'' parsing ''does'' require that <var>Document</var> defines well-formed XML. If an error is detected, a 'domain' exception is raised. The domain exception will attempt to identify the particular sub-term in error, and will list the ancestor elements of the sub-term in error as <code>Tag{(Id)}</code> terms - where ''Id'' is the value of any attribute named id. The <var>Controls</var> applying to in-bound ''(<var>Chars</var> -> <var>Document</var>)'' parsing are: ; <code>extended_characters(Boolean)</code> : Use the extended character entities for XHTML (default true). ; <code>format(Boolean)</code> : Remove layouts when no non-layout character data appears between elements (default true). ; <code>remove_attribute_prefixes(Boolean)</code> : Remove redundant prefixes from attributes - i.e. prefixes denoting the namespace of the parent element (default false). ; <code> allow_ampersand(Boolean) </code> : Allow unescaped ampersand characters (&) to occur in PCDATA (default false). For out-bound ''(<var>Document</var> -> <var>Chars</var>)'' parsing, the only available option is: ; <code>format(Boolean)</code> : Indent the element content, (default true) ===Types=== ; Tag : An atom naming an element ; Name : An atom, not naming an element ; URI : An atom giving the URI of a Namespace ; CharData : A "string": list of character codes. ; DoctypeId : one of: <code>public(CharData,&nbsp;CharData&nbsp;{,&nbsp;DTDLiterals})</code>, <code>system(CharData&nbsp;{,&nbsp;DTDLiterals})</code> or <code>local{(DTDLiterals)}</code> ; DTDLiterals : A non-empty list of <code>dtd_literal(CharData)</code> terms - e.g. [http://www.w3.org/TR/2000/REC-xml-20001006#NT-AttlistDecl attribute-list declarations]. ; Boolean : one of <code>true</code> or <code>false</code> ====xml_subterm( +XMLTerm, ?Subterm )==== unifies <var>Subterm</var> with a sub-term of <var>XMLTerm</var>. This can be especially useful when trying to test or retrieve a deeply-nested subterm from a document, as demonstrated in the [[XML Query Use Cases with xml.pl]] examples. Note that <var>XMLTerm</var> is a sub-term of itself. ====xml_pp( +XMLDocument )==== "pretty prints" <var>XMLDocument</var> on the current output stream. ==Availability== On this site, you can download the [[XML Module]]. The module is also supplied as a library with the following Prologs: * It has been adapted for the [https://logtalk.org/ Logtalk Open source object-oriented extension to Prolog] by Paulo Moura. (See the folder "contributions/xml_parser" from release 2.29.1); * It is available in the [http://eclipseclp.org/ ECLiPSe Constraint Programming System], as a third-party library; * It has been ported to [http://www.picat-lang.org/bprolog/ B-Prolog] by Neng-Fa Zhou. * It has been adapted for [https://sicstus.sics.se/thirdparty.html SICStus Prolog] by Mats Carlsson. * It is included in [https://quintus.sics.se/ Quintus Prolog Release 3.5]. [[XML Query Use Cases with xml.pl]] provides examples of the ways that the code can be used. ==Features of xml.pl== The <code>xml/2</code> data structure has some useful properties. ===Reusability=== Using a native Prolog representation of XML, in which terms represent document 'nodes', makes the parser reusable for any XML application. In effect, xml.pl encapsulates the application-independent tasks of document parsing and generation, which is essential where documents have components from more than one Namespace. ===Same Structure=== The Prolog term representing a document has the same structure as the document itself, which makes the correspondence between the literal representation of the Prolog term and the XML source readily apparent. For example, this simple [http://www.w3.org/Graphics/SVG/ SVG] image: <pre class="xml"> <?xml version="1.0" standalone="no"?> <!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.0//EN" "http://www.w3.org/.../svg10.dtd" [ <!ENTITY redblue "fill: red; stroke: blue; stroke-width: 1"> ]> <svg xmlns="http://www.w3.org/2000/svg" width="500" height="500"> <circle cx=" 25 " cy=" 25 " r=" 24 " style="&redblue;"/> </svg> </pre> ... translates into this Prolog term: <pre class="prolog"> xml( [version="1.0", standalone="no"], [ doctype( svg, public( "-//W3C//DTD SVG 1.0//EN", "http://www.w3.org/.../svg10.dtd" ) ), namespace( 'http://www.w3.org/2000/svg', "", element( svg, [width="500", height="500"], [ element( circle, [cx="25", cy="25", r="24", style="fill: red; stroke: blue; stroke-width: 1"], [] ) ] ) ) ] ). </pre> ===Efficient Manipulation=== Each type of node in an XML document is represented by a different Prolog functor, while data, (PCDATA, CDATA and Attribute Values), are left as "strings", (lists of character codes). The use of distinct functors for mark-up structures enables the efficient recursive traversal of a document, while leaving the data as strings facilitates the application-specific parsing of data content (aka Micro-parsing). For example, to turn every CDATA node into a PCDATA node with tabs expanded into spaces: <pre class="prolog"> cdata_to_pcdata( cdata(CharsWithTabs), pcdata(CharsWithSpaces) ) :- tab_expansion( CharsWithTabs, CharsWithSpaces ). cdata_to_pcdata( xml(Attributes, Content1), xml(Attributes, Content2) ) :- cdata_to_pcdata( Content1, Content2 ). cdata_to_pcdata( namespace(URI,Pfx,Content1), namespace(URI,Pfx,Content2) ) :- cdata_to_pcdata( Content1, Content2 ). cdata_to_pcdata( element(Name,Atts,Content1), element(Name,Atts,Content2) ) :- cdata_to_pcdata( Content1, Content2 ). cdata_to_pcdata( [], [] ). cdata_to_pcdata( [H1|T1], [H2|T2] ) :- cdata_to_pcdata( H1, H2 ), cdata_to_pcdata( T1, T2 ). cdata_to_pcdata( pcdata(Chars), pcdata(Chars) ). cdata_to_pcdata( comment(Chars), comment(Chars) ). cdata_to_pcdata( instructions(Name, Chars), instructions(Name, Chars) ). cdata_to_pcdata( doctype(Tag, DoctypeId), doctype(Tag, DoctypeId) ). </pre> The above uses no 'cuts', but will not create any choice points with ground input. ===Elegance=== The resolution of entity references and the decomposition of the document into distinct nodes means that the calling application is not concerned with the occasionally messy syntax of XML documents. For example, the clean separation of namespace nodes means that Namespaces, which are useful in combining specifications developed separately, have similar usefulness in combining applications developed separately. 0df2a04828def9248585091876f5e3a0be452833 224 223 2018-06-19T13:30:13Z John 2 Updated links to XML specification and escaped PI using wiki markup. wikitext text/x-wiki __NOTOC__ <blockquote> &ldquo;I have a hard time arguing that anything in XML is generically useful any more except for the basic syntax, which lets us apply some very handy low-level tools like parsers and XSLT. The rest (XLink, schemas, etc.) has been a pointless trip into complexity.&rdquo; <cite>[http://lists.w3.org/Archives/Public/www-tag/2002Sep/0303.html Simon St.Laurent]</cite> </blockquote> <blockquote> &ldquo;My own experience is that having Prolog, Scheme, and Haskell available it'll take a gun pointed at my head or an extremely large bribe to make me use XSLT for anything.&rdquo; <cite>[http://cliplab.org/Mail/ciao-users/2001/000206.html Richard A. O'Keefe]</cite> </blockquote> ==Background== xml.pl is a module for parsing XML with Prolog, which provides Prolog applications with a simple ''Document Value Model'' interface to XML documents. It has been used successfully in a number of applications. It supports a subset of XML suitable for XML Data and Worldwide Web applications but it is neither as strict nor as comprehensive as the [https://www.w3.org/TR/xml/ XML 1.0 Specification] mandates. * It is not as strict because, while the specification must eliminate ambiguities, not all errors need to be regarded as faults, and some reasonable examples of real XML usage would have to be rejected if they were. * It is not as comprehensive because, where the XML specification makes provision for more or less complete DTDs to be provided as part of a document, xml.pl actions the local definition of ENTITIES only. Other DTD extensions are treated as commentary. ===Download the [[XML Module]] (xml.pl and plxml)=== xml.pl and plxml, a small Windows application which embodies xml.pl, have been placed into the public domain to encourage the use of Prolog with XML. I hope that they will be useful to you, but they are not supported, and they are provided without any warranty of any kind. ==Specification== Three predicates are exported by the module: <code>xml_parse/[2,3]</code>, <code>xml_subterm/2</code> and <code>xml_pp/1</code> . ====xml_parse( {+Controls,} +?Chars, ?+Document )==== parses <var>Chars</var>, a list of character codes, to/from <var>Document</var>, a data structure of the form <code>xml(Attributes, Content)</code>, where: ''Attributes'' is a list of ''Name''=''CharData'' attributes from the (possibly implicit) XML signature of the document. ''Content'' is a (possibly empty) list comprising occurrences of: ; <code>pcdata(CharData)</code> : Text ; <code>comment(CharData)</code> : An XML comment; ; <code>namespace(URI, Prefix, Element)</code> : a Namespace ; <code>element(Tag, Attributes, Content)</code> : <Tag>..</Tag> encloses Content or <Tag/> if Content is empty <nowiki>[]</nowiki>. ; <code>instructions(Name, CharData)</code> : A [https://www.w3.org/TR/xml/#sec-pi Processing Instruction] ''<''?Name CharData?''>''; ; <code>cdata(CharData)</code> : <![CDATA[CharData]]> ; <code>doctype(Tag, DoctypeId)</code> : DTD <!DOCTYPE .. > The conversions are not completely symmetrical in that weaker XML is accepted than can be generated. Specifically, in-bound ''(Chars -> Document)'' parsing does not require strictly well-formed XML. If <var>Chars</var> does not represent well-formed XML, <var>Document</var> is instantiated to the term <code>malformed(Attributes, Content)</code>. The ''Content'' of a ''malformed/2'' structure can include: ; <code>unparsed( CharData )</code> : Text which has not been parsed ; <code>out_of_context(Tag)</code> : <Tag> is not closed in addition to the parsed-term types. Out-bound ''(<var>Document</var> -> <var>Chars</var>)'' parsing ''does'' require that <var>Document</var> defines well-formed XML. If an error is detected, a 'domain' exception is raised. The domain exception will attempt to identify the particular sub-term in error, and will list the ancestor elements of the sub-term in error as <code>Tag{(Id)}</code> terms - where ''Id'' is the value of any attribute named id. The <var>Controls</var> applying to in-bound ''(<var>Chars</var> -> <var>Document</var>)'' parsing are: ; <code>extended_characters(Boolean)</code> : Use the extended character entities for XHTML (default true). ; <code>format(Boolean)</code> : Remove layouts when no non-layout character data appears between elements (default true). ; <code>remove_attribute_prefixes(Boolean)</code> : Remove redundant prefixes from attributes - i.e. prefixes denoting the namespace of the parent element (default false). ; <code> allow_ampersand(Boolean) </code> : Allow unescaped ampersand characters (&) to occur in PCDATA (default false). For out-bound ''(<var>Document</var> -> <var>Chars</var>)'' parsing, the only available option is: ; <code>format(Boolean)</code> : Indent the element content, (default true) ===Types=== ; Tag : An atom naming an element ; Name : An atom, not naming an element ; URI : An atom giving the URI of a Namespace ; CharData : A "string": list of character codes. ; DoctypeId : one of: <code>public(CharData,&nbsp;CharData&nbsp;{,&nbsp;DTDLiterals})</code>, <code>system(CharData&nbsp;{,&nbsp;DTDLiterals})</code> or <code>local{(DTDLiterals)}</code> ; DTDLiterals : A non-empty list of <code>dtd_literal(CharData)</code> terms - e.g. [https://www.w3.org/TR/xml/#NT-AttlistDecl attribute-list declarations]. ; Boolean : one of <code>true</code> or <code>false</code> ====xml_subterm( +XMLTerm, ?Subterm )==== unifies <var>Subterm</var> with a sub-term of <var>XMLTerm</var>. This can be especially useful when trying to test or retrieve a deeply-nested subterm from a document, as demonstrated in the [[XML Query Use Cases with xml.pl]] examples. Note that <var>XMLTerm</var> is a sub-term of itself. ====xml_pp( +XMLDocument )==== "pretty prints" <var>XMLDocument</var> on the current output stream. ==Availability== On this site, you can download the [[XML Module]]. The module is also supplied as a library with the following Prologs: * It has been adapted for the [https://logtalk.org/ Logtalk Open source object-oriented extension to Prolog] by Paulo Moura. (See the folder "contributions/xml_parser" from release 2.29.1); * It is available in the [http://eclipseclp.org/ ECLiPSe Constraint Programming System], as a third-party library; * It has been ported to [http://www.picat-lang.org/bprolog/ B-Prolog] by Neng-Fa Zhou. * It has been adapted for [https://sicstus.sics.se/thirdparty.html SICStus Prolog] by Mats Carlsson. * It is included in [https://quintus.sics.se/ Quintus Prolog Release 3.5]. [[XML Query Use Cases with xml.pl]] provides examples of the ways that the code can be used. ==Features of xml.pl== The <code>xml/2</code> data structure has some useful properties. ===Reusability=== Using a native Prolog representation of XML, in which terms represent document 'nodes', makes the parser reusable for any XML application. In effect, xml.pl encapsulates the application-independent tasks of document parsing and generation, which is essential where documents have components from more than one Namespace. ===Same Structure=== The Prolog term representing a document has the same structure as the document itself, which makes the correspondence between the literal representation of the Prolog term and the XML source readily apparent. For example, this simple [http://www.w3.org/Graphics/SVG/ SVG] image: <pre class="xml"> <?xml version="1.0" standalone="no"?> <!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.0//EN" "http://www.w3.org/.../svg10.dtd" [ <!ENTITY redblue "fill: red; stroke: blue; stroke-width: 1"> ]> <svg xmlns="http://www.w3.org/2000/svg" width="500" height="500"> <circle cx=" 25 " cy=" 25 " r=" 24 " style="&redblue;"/> </svg> </pre> ... translates into this Prolog term: <pre class="prolog"> xml( [version="1.0", standalone="no"], [ doctype( svg, public( "-//W3C//DTD SVG 1.0//EN", "http://www.w3.org/.../svg10.dtd" ) ), namespace( 'http://www.w3.org/2000/svg', "", element( svg, [width="500", height="500"], [ element( circle, [cx="25", cy="25", r="24", style="fill: red; stroke: blue; stroke-width: 1"], [] ) ] ) ) ] ). </pre> ===Efficient Manipulation=== Each type of node in an XML document is represented by a different Prolog functor, while data, (PCDATA, CDATA and Attribute Values), are left as "strings", (lists of character codes). The use of distinct functors for mark-up structures enables the efficient recursive traversal of a document, while leaving the data as strings facilitates the application-specific parsing of data content (aka Micro-parsing). For example, to turn every CDATA node into a PCDATA node with tabs expanded into spaces: <pre class="prolog"> cdata_to_pcdata( cdata(CharsWithTabs), pcdata(CharsWithSpaces) ) :- tab_expansion( CharsWithTabs, CharsWithSpaces ). cdata_to_pcdata( xml(Attributes, Content1), xml(Attributes, Content2) ) :- cdata_to_pcdata( Content1, Content2 ). cdata_to_pcdata( namespace(URI,Pfx,Content1), namespace(URI,Pfx,Content2) ) :- cdata_to_pcdata( Content1, Content2 ). cdata_to_pcdata( element(Name,Atts,Content1), element(Name,Atts,Content2) ) :- cdata_to_pcdata( Content1, Content2 ). cdata_to_pcdata( [], [] ). cdata_to_pcdata( [H1|T1], [H2|T2] ) :- cdata_to_pcdata( H1, H2 ), cdata_to_pcdata( T1, T2 ). cdata_to_pcdata( pcdata(Chars), pcdata(Chars) ). cdata_to_pcdata( comment(Chars), comment(Chars) ). cdata_to_pcdata( instructions(Name, Chars), instructions(Name, Chars) ). cdata_to_pcdata( doctype(Tag, DoctypeId), doctype(Tag, DoctypeId) ). </pre> The above uses no 'cuts', but will not create any choice points with ground input. ===Elegance=== The resolution of entity references and the decomposition of the document into distinct nodes means that the calling application is not concerned with the occasionally messy syntax of XML documents. For example, the clean separation of namespace nodes means that Namespaces, which are useful in combining specifications developed separately, have similar usefulness in combining applications developed separately. 061ae476455c39b3a02269a85bcf227ae3475d8a 238 224 2020-01-30T22:55:12Z John 2 Simon St.Laurent link upgraded to https wikitext text/x-wiki __NOTOC__ <blockquote> &ldquo;I have a hard time arguing that anything in XML is generically useful any more except for the basic syntax, which lets us apply some very handy low-level tools like parsers and XSLT. The rest (XLink, schemas, etc.) has been a pointless trip into complexity.&rdquo; <cite>[https://lists.w3.org/Archives/Public/www-tag/2002Sep/0303.html Simon St.Laurent]</cite> </blockquote> <blockquote> &ldquo;My own experience is that having Prolog, Scheme, and Haskell available it'll take a gun pointed at my head or an extremely large bribe to make me use XSLT for anything.&rdquo; <cite>[http://cliplab.org/Mail/ciao-users/2001/000206.html Richard A. O'Keefe]</cite> </blockquote> ==Background== xml.pl is a module for parsing XML with Prolog, which provides Prolog applications with a simple ''Document Value Model'' interface to XML documents. It has been used successfully in a number of applications. It supports a subset of XML suitable for XML Data and Worldwide Web applications but it is neither as strict nor as comprehensive as the [https://www.w3.org/TR/xml/ XML 1.0 Specification] mandates. * It is not as strict because, while the specification must eliminate ambiguities, not all errors need to be regarded as faults, and some reasonable examples of real XML usage would have to be rejected if they were. * It is not as comprehensive because, where the XML specification makes provision for more or less complete DTDs to be provided as part of a document, xml.pl actions the local definition of ENTITIES only. Other DTD extensions are treated as commentary. ===Download the [[XML Module]] (xml.pl and plxml)=== xml.pl and plxml, a small Windows application which embodies xml.pl, have been placed into the public domain to encourage the use of Prolog with XML. I hope that they will be useful to you, but they are not supported, and they are provided without any warranty of any kind. ==Specification== Three predicates are exported by the module: <code>xml_parse/[2,3]</code>, <code>xml_subterm/2</code> and <code>xml_pp/1</code> . ====xml_parse( {+Controls,} +?Chars, ?+Document )==== parses <var>Chars</var>, a list of character codes, to/from <var>Document</var>, a data structure of the form <code>xml(Attributes, Content)</code>, where: ''Attributes'' is a list of ''Name''=''CharData'' attributes from the (possibly implicit) XML signature of the document. ''Content'' is a (possibly empty) list comprising occurrences of: ; <code>pcdata(CharData)</code> : Text ; <code>comment(CharData)</code> : An XML comment; ; <code>namespace(URI, Prefix, Element)</code> : a Namespace ; <code>element(Tag, Attributes, Content)</code> : <Tag>..</Tag> encloses Content or <Tag/> if Content is empty <nowiki>[]</nowiki>. ; <code>instructions(Name, CharData)</code> : A [https://www.w3.org/TR/xml/#sec-pi Processing Instruction] ''<''?Name CharData?''>''; ; <code>cdata(CharData)</code> : <![CDATA[CharData]]> ; <code>doctype(Tag, DoctypeId)</code> : DTD <!DOCTYPE .. > The conversions are not completely symmetrical in that weaker XML is accepted than can be generated. Specifically, in-bound ''(Chars -> Document)'' parsing does not require strictly well-formed XML. If <var>Chars</var> does not represent well-formed XML, <var>Document</var> is instantiated to the term <code>malformed(Attributes, Content)</code>. The ''Content'' of a ''malformed/2'' structure can include: ; <code>unparsed( CharData )</code> : Text which has not been parsed ; <code>out_of_context(Tag)</code> : <Tag> is not closed in addition to the parsed-term types. Out-bound ''(<var>Document</var> -> <var>Chars</var>)'' parsing ''does'' require that <var>Document</var> defines well-formed XML. If an error is detected, a 'domain' exception is raised. The domain exception will attempt to identify the particular sub-term in error, and will list the ancestor elements of the sub-term in error as <code>Tag{(Id)}</code> terms - where ''Id'' is the value of any attribute named id. The <var>Controls</var> applying to in-bound ''(<var>Chars</var> -> <var>Document</var>)'' parsing are: ; <code>extended_characters(Boolean)</code> : Use the extended character entities for XHTML (default true). ; <code>format(Boolean)</code> : Remove layouts when no non-layout character data appears between elements (default true). ; <code>remove_attribute_prefixes(Boolean)</code> : Remove redundant prefixes from attributes - i.e. prefixes denoting the namespace of the parent element (default false). ; <code> allow_ampersand(Boolean) </code> : Allow unescaped ampersand characters (&) to occur in PCDATA (default false). For out-bound ''(<var>Document</var> -> <var>Chars</var>)'' parsing, the only available option is: ; <code>format(Boolean)</code> : Indent the element content, (default true) ===Types=== ; Tag : An atom naming an element ; Name : An atom, not naming an element ; URI : An atom giving the URI of a Namespace ; CharData : A "string": list of character codes. ; DoctypeId : one of: <code>public(CharData,&nbsp;CharData&nbsp;{,&nbsp;DTDLiterals})</code>, <code>system(CharData&nbsp;{,&nbsp;DTDLiterals})</code> or <code>local{(DTDLiterals)}</code> ; DTDLiterals : A non-empty list of <code>dtd_literal(CharData)</code> terms - e.g. [https://www.w3.org/TR/xml/#NT-AttlistDecl attribute-list declarations]. ; Boolean : one of <code>true</code> or <code>false</code> ====xml_subterm( +XMLTerm, ?Subterm )==== unifies <var>Subterm</var> with a sub-term of <var>XMLTerm</var>. This can be especially useful when trying to test or retrieve a deeply-nested subterm from a document, as demonstrated in the [[XML Query Use Cases with xml.pl]] examples. Note that <var>XMLTerm</var> is a sub-term of itself. ====xml_pp( +XMLDocument )==== "pretty prints" <var>XMLDocument</var> on the current output stream. ==Availability== On this site, you can download the [[XML Module]]. The module is also supplied as a library with the following Prologs: * It has been adapted for the [https://logtalk.org/ Logtalk Open source object-oriented extension to Prolog] by Paulo Moura. (See the folder "contributions/xml_parser" from release 2.29.1); * It is available in the [http://eclipseclp.org/ ECLiPSe Constraint Programming System], as a third-party library; * It has been ported to [http://www.picat-lang.org/bprolog/ B-Prolog] by Neng-Fa Zhou. * It has been adapted for [https://sicstus.sics.se/thirdparty.html SICStus Prolog] by Mats Carlsson. * It is included in [https://quintus.sics.se/ Quintus Prolog Release 3.5]. [[XML Query Use Cases with xml.pl]] provides examples of the ways that the code can be used. ==Features of xml.pl== The <code>xml/2</code> data structure has some useful properties. ===Reusability=== Using a native Prolog representation of XML, in which terms represent document 'nodes', makes the parser reusable for any XML application. In effect, xml.pl encapsulates the application-independent tasks of document parsing and generation, which is essential where documents have components from more than one Namespace. ===Same Structure=== The Prolog term representing a document has the same structure as the document itself, which makes the correspondence between the literal representation of the Prolog term and the XML source readily apparent. For example, this simple [http://www.w3.org/Graphics/SVG/ SVG] image: <pre class="xml"> <?xml version="1.0" standalone="no"?> <!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.0//EN" "http://www.w3.org/.../svg10.dtd" [ <!ENTITY redblue "fill: red; stroke: blue; stroke-width: 1"> ]> <svg xmlns="http://www.w3.org/2000/svg" width="500" height="500"> <circle cx=" 25 " cy=" 25 " r=" 24 " style="&redblue;"/> </svg> </pre> ... translates into this Prolog term: <pre class="prolog"> xml( [version="1.0", standalone="no"], [ doctype( svg, public( "-//W3C//DTD SVG 1.0//EN", "http://www.w3.org/.../svg10.dtd" ) ), namespace( 'http://www.w3.org/2000/svg', "", element( svg, [width="500", height="500"], [ element( circle, [cx="25", cy="25", r="24", style="fill: red; stroke: blue; stroke-width: 1"], [] ) ] ) ) ] ). </pre> ===Efficient Manipulation=== Each type of node in an XML document is represented by a different Prolog functor, while data, (PCDATA, CDATA and Attribute Values), are left as "strings", (lists of character codes). The use of distinct functors for mark-up structures enables the efficient recursive traversal of a document, while leaving the data as strings facilitates the application-specific parsing of data content (aka Micro-parsing). For example, to turn every CDATA node into a PCDATA node with tabs expanded into spaces: <pre class="prolog"> cdata_to_pcdata( cdata(CharsWithTabs), pcdata(CharsWithSpaces) ) :- tab_expansion( CharsWithTabs, CharsWithSpaces ). cdata_to_pcdata( xml(Attributes, Content1), xml(Attributes, Content2) ) :- cdata_to_pcdata( Content1, Content2 ). cdata_to_pcdata( namespace(URI,Pfx,Content1), namespace(URI,Pfx,Content2) ) :- cdata_to_pcdata( Content1, Content2 ). cdata_to_pcdata( element(Name,Atts,Content1), element(Name,Atts,Content2) ) :- cdata_to_pcdata( Content1, Content2 ). cdata_to_pcdata( [], [] ). cdata_to_pcdata( [H1|T1], [H2|T2] ) :- cdata_to_pcdata( H1, H2 ), cdata_to_pcdata( T1, T2 ). cdata_to_pcdata( pcdata(Chars), pcdata(Chars) ). cdata_to_pcdata( comment(Chars), comment(Chars) ). cdata_to_pcdata( instructions(Name, Chars), instructions(Name, Chars) ). cdata_to_pcdata( doctype(Tag, DoctypeId), doctype(Tag, DoctypeId) ). </pre> The above uses no 'cuts', but will not create any choice points with ground input. ===Elegance=== The resolution of entity references and the decomposition of the document into distinct nodes means that the calling application is not concerned with the occasionally messy syntax of XML documents. For example, the clean separation of namespace nodes means that Namespaces, which are useful in combining specifications developed separately, have similar usefulness in combining applications developed separately. fbdf46628efae32bfa21094635a64d5d2cf60288 245 238 2020-07-08T20:08:45Z John 2 Removed direct link to B-Prolog page, which is broken. wikitext text/x-wiki __NOTOC__ <blockquote> &ldquo;I have a hard time arguing that anything in XML is generically useful any more except for the basic syntax, which lets us apply some very handy low-level tools like parsers and XSLT. The rest (XLink, schemas, etc.) has been a pointless trip into complexity.&rdquo; <cite>[https://lists.w3.org/Archives/Public/www-tag/2002Sep/0303.html Simon St.Laurent]</cite> </blockquote> <blockquote> &ldquo;My own experience is that having Prolog, Scheme, and Haskell available it'll take a gun pointed at my head or an extremely large bribe to make me use XSLT for anything.&rdquo; <cite>[http://cliplab.org/Mail/ciao-users/2001/000206.html Richard A. O'Keefe]</cite> </blockquote> ==Background== xml.pl is a module for parsing XML with Prolog, which provides Prolog applications with a simple ''Document Value Model'' interface to XML documents. It has been used successfully in a number of applications. It supports a subset of XML suitable for XML Data and Worldwide Web applications but it is neither as strict nor as comprehensive as the [https://www.w3.org/TR/xml/ XML 1.0 Specification] mandates. * It is not as strict because, while the specification must eliminate ambiguities, not all errors need to be regarded as faults, and some reasonable examples of real XML usage would have to be rejected if they were. * It is not as comprehensive because, where the XML specification makes provision for more or less complete DTDs to be provided as part of a document, xml.pl actions the local definition of ENTITIES only. Other DTD extensions are treated as commentary. ===Download the [[XML Module]] (xml.pl and plxml)=== xml.pl and plxml, a small Windows application which embodies xml.pl, have been placed into the public domain to encourage the use of Prolog with XML. I hope that they will be useful to you, but they are not supported, and they are provided without any warranty of any kind. ==Specification== Three predicates are exported by the module: <code>xml_parse/[2,3]</code>, <code>xml_subterm/2</code> and <code>xml_pp/1</code> . ====xml_parse( {+Controls,} +?Chars, ?+Document )==== parses <var>Chars</var>, a list of character codes, to/from <var>Document</var>, a data structure of the form <code>xml(Attributes, Content)</code>, where: ''Attributes'' is a list of ''Name''=''CharData'' attributes from the (possibly implicit) XML signature of the document. ''Content'' is a (possibly empty) list comprising occurrences of: ; <code>pcdata(CharData)</code> : Text ; <code>comment(CharData)</code> : An XML comment; ; <code>namespace(URI, Prefix, Element)</code> : a Namespace ; <code>element(Tag, Attributes, Content)</code> : <Tag>..</Tag> encloses Content or <Tag/> if Content is empty <nowiki>[]</nowiki>. ; <code>instructions(Name, CharData)</code> : A [https://www.w3.org/TR/xml/#sec-pi Processing Instruction] ''<''?Name CharData?''>''; ; <code>cdata(CharData)</code> : <![CDATA[CharData]]> ; <code>doctype(Tag, DoctypeId)</code> : DTD <!DOCTYPE .. > The conversions are not completely symmetrical in that weaker XML is accepted than can be generated. Specifically, in-bound ''(Chars -> Document)'' parsing does not require strictly well-formed XML. If <var>Chars</var> does not represent well-formed XML, <var>Document</var> is instantiated to the term <code>malformed(Attributes, Content)</code>. The ''Content'' of a ''malformed/2'' structure can include: ; <code>unparsed( CharData )</code> : Text which has not been parsed ; <code>out_of_context(Tag)</code> : <Tag> is not closed in addition to the parsed-term types. Out-bound ''(<var>Document</var> -> <var>Chars</var>)'' parsing ''does'' require that <var>Document</var> defines well-formed XML. If an error is detected, a 'domain' exception is raised. The domain exception will attempt to identify the particular sub-term in error, and will list the ancestor elements of the sub-term in error as <code>Tag{(Id)}</code> terms - where ''Id'' is the value of any attribute named id. The <var>Controls</var> applying to in-bound ''(<var>Chars</var> -> <var>Document</var>)'' parsing are: ; <code>extended_characters(Boolean)</code> : Use the extended character entities for XHTML (default true). ; <code>format(Boolean)</code> : Remove layouts when no non-layout character data appears between elements (default true). ; <code>remove_attribute_prefixes(Boolean)</code> : Remove redundant prefixes from attributes - i.e. prefixes denoting the namespace of the parent element (default false). ; <code> allow_ampersand(Boolean) </code> : Allow unescaped ampersand characters (&) to occur in PCDATA (default false). For out-bound ''(<var>Document</var> -> <var>Chars</var>)'' parsing, the only available option is: ; <code>format(Boolean)</code> : Indent the element content, (default true) ===Types=== ; Tag : An atom naming an element ; Name : An atom, not naming an element ; URI : An atom giving the URI of a Namespace ; CharData : A "string": list of character codes. ; DoctypeId : one of: <code>public(CharData,&nbsp;CharData&nbsp;{,&nbsp;DTDLiterals})</code>, <code>system(CharData&nbsp;{,&nbsp;DTDLiterals})</code> or <code>local{(DTDLiterals)}</code> ; DTDLiterals : A non-empty list of <code>dtd_literal(CharData)</code> terms - e.g. [https://www.w3.org/TR/xml/#NT-AttlistDecl attribute-list declarations]. ; Boolean : one of <code>true</code> or <code>false</code> ====xml_subterm( +XMLTerm, ?Subterm )==== unifies <var>Subterm</var> with a sub-term of <var>XMLTerm</var>. This can be especially useful when trying to test or retrieve a deeply-nested subterm from a document, as demonstrated in the [[XML Query Use Cases with xml.pl]] examples. Note that <var>XMLTerm</var> is a sub-term of itself. ====xml_pp( +XMLDocument )==== "pretty prints" <var>XMLDocument</var> on the current output stream. ==Availability== On this site, you can download the [[XML Module]]. The module is also supplied as a library with the following Prologs: * It has been adapted for the [https://logtalk.org/ Logtalk Open source object-oriented extension to Prolog] by Paulo Moura. (See the folder "contributions/xml_parser" from release 2.29.1); * It is available in the [http://eclipseclp.org/ ECLiPSe Constraint Programming System], as a third-party library; * It has been ported to [[Wikipedia:B-Prolog|B-Prolog]] by Neng-Fa Zhou. * It has been adapted for [https://sicstus.sics.se/thirdparty.html SICStus Prolog] by Mats Carlsson. * It is included in [https://quintus.sics.se/ Quintus Prolog Release 3.5]. [[XML Query Use Cases with xml.pl]] provides examples of the ways that the code can be used. ==Features of xml.pl== The <code>xml/2</code> data structure has some useful properties. ===Reusability=== Using a native Prolog representation of XML, in which terms represent document 'nodes', makes the parser reusable for any XML application. In effect, xml.pl encapsulates the application-independent tasks of document parsing and generation, which is essential where documents have components from more than one Namespace. ===Same Structure=== The Prolog term representing a document has the same structure as the document itself, which makes the correspondence between the literal representation of the Prolog term and the XML source readily apparent. For example, this simple [http://www.w3.org/Graphics/SVG/ SVG] image: <pre class="xml"> <?xml version="1.0" standalone="no"?> <!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.0//EN" "http://www.w3.org/.../svg10.dtd" [ <!ENTITY redblue "fill: red; stroke: blue; stroke-width: 1"> ]> <svg xmlns="http://www.w3.org/2000/svg" width="500" height="500"> <circle cx=" 25 " cy=" 25 " r=" 24 " style="&redblue;"/> </svg> </pre> ... translates into this Prolog term: <pre class="prolog"> xml( [version="1.0", standalone="no"], [ doctype( svg, public( "-//W3C//DTD SVG 1.0//EN", "http://www.w3.org/.../svg10.dtd" ) ), namespace( 'http://www.w3.org/2000/svg', "", element( svg, [width="500", height="500"], [ element( circle, [cx="25", cy="25", r="24", style="fill: red; stroke: blue; stroke-width: 1"], [] ) ] ) ) ] ). </pre> ===Efficient Manipulation=== Each type of node in an XML document is represented by a different Prolog functor, while data, (PCDATA, CDATA and Attribute Values), are left as "strings", (lists of character codes). The use of distinct functors for mark-up structures enables the efficient recursive traversal of a document, while leaving the data as strings facilitates the application-specific parsing of data content (aka Micro-parsing). For example, to turn every CDATA node into a PCDATA node with tabs expanded into spaces: <pre class="prolog"> cdata_to_pcdata( cdata(CharsWithTabs), pcdata(CharsWithSpaces) ) :- tab_expansion( CharsWithTabs, CharsWithSpaces ). cdata_to_pcdata( xml(Attributes, Content1), xml(Attributes, Content2) ) :- cdata_to_pcdata( Content1, Content2 ). cdata_to_pcdata( namespace(URI,Pfx,Content1), namespace(URI,Pfx,Content2) ) :- cdata_to_pcdata( Content1, Content2 ). cdata_to_pcdata( element(Name,Atts,Content1), element(Name,Atts,Content2) ) :- cdata_to_pcdata( Content1, Content2 ). cdata_to_pcdata( [], [] ). cdata_to_pcdata( [H1|T1], [H2|T2] ) :- cdata_to_pcdata( H1, H2 ), cdata_to_pcdata( T1, T2 ). cdata_to_pcdata( pcdata(Chars), pcdata(Chars) ). cdata_to_pcdata( comment(Chars), comment(Chars) ). cdata_to_pcdata( instructions(Name, Chars), instructions(Name, Chars) ). cdata_to_pcdata( doctype(Tag, DoctypeId), doctype(Tag, DoctypeId) ). </pre> The above uses no 'cuts', but will not create any choice points with ground input. ===Elegance=== The resolution of entity references and the decomposition of the document into distinct nodes means that the calling application is not concerned with the occasionally messy syntax of XML documents. For example, the clean separation of namespace nodes means that Namespaces, which are useful in combining specifications developed separately, have similar usefulness in combining applications developed separately. a5325e94fe983d5cf0593020af94acca612d7a1f 251 245 2022-01-30T19:12:16Z John 2 /* Removed micro-parsing, which is not mentioned now.*/ wikitext text/x-wiki __NOTOC__ <blockquote> &ldquo;I have a hard time arguing that anything in XML is generically useful any more except for the basic syntax, which lets us apply some very handy low-level tools like parsers and XSLT. The rest (XLink, schemas, etc.) has been a pointless trip into complexity.&rdquo; <cite>[https://lists.w3.org/Archives/Public/www-tag/2002Sep/0303.html Simon St.Laurent]</cite> </blockquote> <blockquote> &ldquo;My own experience is that having Prolog, Scheme, and Haskell available it'll take a gun pointed at my head or an extremely large bribe to make me use XSLT for anything.&rdquo; <cite>[http://cliplab.org/Mail/ciao-users/2001/000206.html Richard A. O'Keefe]</cite> </blockquote> ==Background== xml.pl is a module for parsing XML with Prolog, which provides Prolog applications with a simple ''Document Value Model'' interface to XML documents. It has been used successfully in a number of applications. It supports a subset of XML suitable for XML Data and Worldwide Web applications but it is neither as strict nor as comprehensive as the [https://www.w3.org/TR/xml/ XML 1.0 Specification] mandates. * It is not as strict because, while the specification must eliminate ambiguities, not all errors need to be regarded as faults, and some reasonable examples of real XML usage would have to be rejected if they were. * It is not as comprehensive because, where the XML specification makes provision for more or less complete DTDs to be provided as part of a document, xml.pl actions the local definition of ENTITIES only. Other DTD extensions are treated as commentary. ===Download the [[XML Module]] (xml.pl and plxml)=== xml.pl and plxml, a small Windows application which embodies xml.pl, have been placed into the public domain to encourage the use of Prolog with XML. I hope that they will be useful to you, but they are not supported, and they are provided without any warranty of any kind. ==Specification== Three predicates are exported by the module: <code>xml_parse/[2,3]</code>, <code>xml_subterm/2</code> and <code>xml_pp/1</code> . ====xml_parse( {+Controls,} +?Chars, ?+Document )==== parses <var>Chars</var>, a list of character codes, to/from <var>Document</var>, a data structure of the form <code>xml(Attributes, Content)</code>, where: ''Attributes'' is a list of ''Name''=''CharData'' attributes from the (possibly implicit) XML signature of the document. ''Content'' is a (possibly empty) list comprising occurrences of: ; <code>pcdata(CharData)</code> : Text ; <code>comment(CharData)</code> : An XML comment; ; <code>namespace(URI, Prefix, Element)</code> : a Namespace ; <code>element(Tag, Attributes, Content)</code> : <Tag>..</Tag> encloses Content or <Tag/> if Content is empty <nowiki>[]</nowiki>. ; <code>instructions(Name, CharData)</code> : A [https://www.w3.org/TR/xml/#sec-pi Processing Instruction] ''<''?Name CharData?''>''; ; <code>cdata(CharData)</code> : <![CDATA[CharData]]> ; <code>doctype(Tag, DoctypeId)</code> : DTD <!DOCTYPE .. > The conversions are not completely symmetrical in that weaker XML is accepted than can be generated. Specifically, in-bound ''(Chars -> Document)'' parsing does not require strictly well-formed XML. If <var>Chars</var> does not represent well-formed XML, <var>Document</var> is instantiated to the term <code>malformed(Attributes, Content)</code>. The ''Content'' of a ''malformed/2'' structure can include: ; <code>unparsed( CharData )</code> : Text which has not been parsed ; <code>out_of_context(Tag)</code> : <Tag> is not closed in addition to the parsed-term types. Out-bound ''(<var>Document</var> -> <var>Chars</var>)'' parsing ''does'' require that <var>Document</var> defines well-formed XML. If an error is detected, a 'domain' exception is raised. The domain exception will attempt to identify the particular sub-term in error, and will list the ancestor elements of the sub-term in error as <code>Tag{(Id)}</code> terms - where ''Id'' is the value of any attribute named id. The <var>Controls</var> applying to in-bound ''(<var>Chars</var> -> <var>Document</var>)'' parsing are: ; <code>extended_characters(Boolean)</code> : Use the extended character entities for XHTML (default true). ; <code>format(Boolean)</code> : Remove layouts when no non-layout character data appears between elements (default true). ; <code>remove_attribute_prefixes(Boolean)</code> : Remove redundant prefixes from attributes - i.e. prefixes denoting the namespace of the parent element (default false). ; <code> allow_ampersand(Boolean) </code> : Allow unescaped ampersand characters (&) to occur in PCDATA (default false). For out-bound ''(<var>Document</var> -> <var>Chars</var>)'' parsing, the only available option is: ; <code>format(Boolean)</code> : Indent the element content, (default true) ===Types=== ; Tag : An atom naming an element ; Name : An atom, not naming an element ; URI : An atom giving the URI of a Namespace ; CharData : A "string": list of character codes. ; DoctypeId : one of: <code>public(CharData,&nbsp;CharData&nbsp;{,&nbsp;DTDLiterals})</code>, <code>system(CharData&nbsp;{,&nbsp;DTDLiterals})</code> or <code>local{(DTDLiterals)}</code> ; DTDLiterals : A non-empty list of <code>dtd_literal(CharData)</code> terms - e.g. [https://www.w3.org/TR/xml/#NT-AttlistDecl attribute-list declarations]. ; Boolean : one of <code>true</code> or <code>false</code> ====xml_subterm( +XMLTerm, ?Subterm )==== unifies <var>Subterm</var> with a sub-term of <var>XMLTerm</var>. This can be especially useful when trying to test or retrieve a deeply-nested subterm from a document, as demonstrated in the [[XML Query Use Cases with xml.pl]] examples. Note that <var>XMLTerm</var> is a sub-term of itself. ====xml_pp( +XMLDocument )==== "pretty prints" <var>XMLDocument</var> on the current output stream. ==Availability== On this site, you can download the [[XML Module]]. The module is also supplied as a library with the following Prologs: * It has been adapted for the [https://logtalk.org/ Logtalk Open source object-oriented extension to Prolog] by Paulo Moura. (See the folder "contributions/xml_parser" from release 2.29.1); * It is available in the [http://eclipseclp.org/ ECLiPSe Constraint Programming System], as a third-party library; * It has been ported to [[Wikipedia:B-Prolog|B-Prolog]] by Neng-Fa Zhou. * It has been adapted for [https://sicstus.sics.se/thirdparty.html SICStus Prolog] by Mats Carlsson. * It is included in [https://quintus.sics.se/ Quintus Prolog Release 3.5]. [[XML Query Use Cases with xml.pl]] provides examples of the ways that the code can be used. ==Features of xml.pl== The <code>xml/2</code> data structure has some useful properties. ===Reusability=== Using a native Prolog representation of XML, in which terms represent document 'nodes', makes the parser reusable for any XML application. In effect, xml.pl encapsulates the application-independent tasks of document parsing and generation, which is essential where documents have components from more than one Namespace. ===Same Structure=== The Prolog term representing a document has the same structure as the document itself, which makes the correspondence between the literal representation of the Prolog term and the XML source readily apparent. For example, this simple [http://www.w3.org/Graphics/SVG/ SVG] image: <pre class="xml"> <?xml version="1.0" standalone="no"?> <!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.0//EN" "http://www.w3.org/.../svg10.dtd" [ <!ENTITY redblue "fill: red; stroke: blue; stroke-width: 1"> ]> <svg xmlns="http://www.w3.org/2000/svg" width="500" height="500"> <circle cx=" 25 " cy=" 25 " r=" 24 " style="&redblue;"/> </svg> </pre> ... translates into this Prolog term: <pre class="prolog"> xml( [version="1.0", standalone="no"], [ doctype( svg, public( "-//W3C//DTD SVG 1.0//EN", "http://www.w3.org/.../svg10.dtd" ) ), namespace( 'http://www.w3.org/2000/svg', "", element( svg, [width="500", height="500"], [ element( circle, [cx="25", cy="25", r="24", style="fill: red; stroke: blue; stroke-width: 1"], [] ) ] ) ) ] ). </pre> ===Efficient Manipulation=== Each type of node in an XML document is represented by a different Prolog functor, while data, (PCDATA, CDATA and Attribute Values), are left as "strings", (lists of character codes). The use of distinct functors for mark-up structures enables the efficient recursive traversal of a document, while leaving the data as strings facilitates the application-specific parsing of data content. For example, to turn every CDATA node into a PCDATA node with tabs expanded into spaces: <pre class="prolog"> cdata_to_pcdata( cdata(CharsWithTabs), pcdata(CharsWithSpaces) ) :- tab_expansion( CharsWithTabs, CharsWithSpaces ). cdata_to_pcdata( xml(Attributes, Content1), xml(Attributes, Content2) ) :- cdata_to_pcdata( Content1, Content2 ). cdata_to_pcdata( namespace(URI,Pfx,Content1), namespace(URI,Pfx,Content2) ) :- cdata_to_pcdata( Content1, Content2 ). cdata_to_pcdata( element(Name,Atts,Content1), element(Name,Atts,Content2) ) :- cdata_to_pcdata( Content1, Content2 ). cdata_to_pcdata( [], [] ). cdata_to_pcdata( [H1|T1], [H2|T2] ) :- cdata_to_pcdata( H1, H2 ), cdata_to_pcdata( T1, T2 ). cdata_to_pcdata( pcdata(Chars), pcdata(Chars) ). cdata_to_pcdata( comment(Chars), comment(Chars) ). cdata_to_pcdata( instructions(Name, Chars), instructions(Name, Chars) ). cdata_to_pcdata( doctype(Tag, DoctypeId), doctype(Tag, DoctypeId) ). </pre> The above uses no 'cuts', but will not create any choice points with ground input. ===Elegance=== The resolution of entity references and the decomposition of the document into distinct nodes means that the calling application is not concerned with the occasionally messy syntax of XML documents. For example, the clean separation of namespace nodes means that Namespaces, which are useful in combining specifications developed separately, have similar usefulness in combining applications developed separately. 688e00df828700adc50fa8733f9e1422034ad507 0 22 215 146 2018-02-04T16:46:44Z John 2 Updated Amazon links wikitext text/x-wiki __NOTOC__ Out of the many Prolog programming books that I have read, I consider these to be the best. == Starting Out == Prolog is a deep subject, rather than a broad one, so it is best studied in stages. Clocksin &amp; Mellish's [http://amzn.to/2GNAW9U Programming in Prolog] is the definitive introductory text on Prolog. Most importantly, it will help you to start programming straight away. == More Advanced Applications == I regard Peter Flach's [http://amzn.to/2nACWuu Simply Logical: Intelligent Reasoning by Example] as the best advanced text currently available. It deals with both theoretical and practical aspects of logic programming but doesn't assume prior knowledge beyond that you will have gained from &quot;Programming in Prolog&quot;. You can download the programs in the book, and the book as a <abbr title="Portable Document Format">PDF</abbr> file, from the [http://www.cs.bris.ac.uk/~flach/SimplyLogical.html Simply Logical page at Bristol University]. == The Last Word == Robert Kowalski's classic [http://amzn.to/2EDfWSM Logic for Problem Solving] is essential reading for Prolog programmers. [http://amzn.to/2nGDf65 Logic for Problem Solving, Revisited] is a more recent, revised edition. The original book has been scanned into PDF format and can be downloaded from [http://www.doc.ic.ac.uk/~rak/ Robert Kowalski's homepage]. == Getting Technical == Performance and memory utilisation become important when Prolog is used to solve complex problems. David Harel's [http://amzn.to/2E2ooy5 Algorithmics] is a very accessible treatment of program behaviour. It isn't tied to one programming language, and the techniques described are readily applicable to Prolog programs. Richard O'Keefe's [http://amzn.to/2GI0dlX The Craft of Prolog] is a superb exposition of the techniques that can be employed to work ''with'' Prolog, rather than fighting against it, and the rationale behind them. 6b0acda864dacbcd77abed38164de1cf858f6f5f 216 215 2018-03-28T20:01:51Z John 2 Updated link to Simply Logical at briis.ac.uk wikitext text/x-wiki __NOTOC__ Out of the many Prolog programming books that I have read, I consider these to be the best. == Starting Out == Prolog is a deep subject, rather than a broad one, so it is best studied in stages. Clocksin &amp; Mellish's [http://amzn.to/2GNAW9U Programming in Prolog] is the definitive introductory text on Prolog. Most importantly, it will help you to start programming straight away. == More Advanced Applications == I regard Peter Flach's [http://amzn.to/2nACWuu Simply Logical: Intelligent Reasoning by Example] as the best advanced text currently available. It deals with both theoretical and practical aspects of logic programming but doesn't assume prior knowledge beyond that you will have gained from &quot;Programming in Prolog&quot;. You can download the programs in the book, and the book as a <abbr title="Portable Document Format">PDF</abbr> file, from the [http://people.cs.bris.ac.uk/~flach/SimplyLogical.html Simply Logical page at Bristol University]. == The Last Word == Robert Kowalski's classic [http://amzn.to/2EDfWSM Logic for Problem Solving] is essential reading for Prolog programmers. [http://amzn.to/2nGDf65 Logic for Problem Solving, Revisited] is a more recent, revised edition. The original book has been scanned into PDF format and can be downloaded from [http://www.doc.ic.ac.uk/~rak/ Robert Kowalski's homepage]. == Getting Technical == Performance and memory utilisation become important when Prolog is used to solve complex problems. David Harel's [http://amzn.to/2E2ooy5 Algorithmics] is a very accessible treatment of program behaviour. It isn't tied to one programming language, and the techniques described are readily applicable to Prolog programs. Richard O'Keefe's [http://amzn.to/2GI0dlX The Craft of Prolog] is a superb exposition of the techniques that can be employed to work ''with'' Prolog, rather than fighting against it, and the rationale behind them. 4bbb5313f73295c9b3304e789f82c6993fb9b54e 218 216 2018-04-29T23:29:50Z John 2 /* More Advanced Applications */ wikitext text/x-wiki __NOTOC__ Out of the many Prolog programming books that I have read, I consider these to be the best. == Starting Out == Prolog is a deep subject, rather than a broad one, so it is best studied in stages. Clocksin &amp; Mellish's [http://amzn.to/2GNAW9U Programming in Prolog] is the definitive introductory text on Prolog. Most importantly, it will help you to start programming straight away. == More Advanced Applications == I regard Peter Flach's [https://www.amazon.co.uk/Simply-Logical-Intelligent-Reasoning-Professional/dp/0471941522/278-2628466-8703061?tag=bindingtimeli-21 Simply Logical: Intelligent Reasoning by Example] as the best advanced text. It deals with both theoretical and practical aspects of logic programming but doesn't assume prior knowledge beyond that you will have gained from &quot;Programming in Prolog&quot;. It has an interactive edition at [http://book.simply-logical.space/ simply-logical.space] or you can download the programs in the book, and the book as a <abbr title="Portable Document Format">PDF</abbr> file, from the [http://www.cs.bris.ac.uk/~flach/SimplyLogical.html Simply Logical page at Bristol University]. == The Last Word == Robert Kowalski's classic [http://amzn.to/2EDfWSM Logic for Problem Solving] is essential reading for Prolog programmers. [http://amzn.to/2nGDf65 Logic for Problem Solving, Revisited] is a more recent, revised edition. The original book has been scanned into PDF format and can be downloaded from [http://www.doc.ic.ac.uk/~rak/ Robert Kowalski's homepage]. == Getting Technical == Performance and memory utilisation become important when Prolog is used to solve complex problems. David Harel's [http://amzn.to/2E2ooy5 Algorithmics] is a very accessible treatment of program behaviour. It isn't tied to one programming language, and the techniques described are readily applicable to Prolog programs. Richard O'Keefe's [http://amzn.to/2GI0dlX The Craft of Prolog] is a superb exposition of the techniques that can be employed to work ''with'' Prolog, rather than fighting against it, and the rationale behind them. 49d652b4ec98028d34b8f4973f2049125012e8a0 219 218 2018-05-06T00:41:09Z John 2 Updated link to Simply Logical at bris.ac.uk again. wikitext text/x-wiki __NOTOC__ Out of the many Prolog programming books that I have read, I consider these to be the best. == Starting Out == Prolog is a deep subject, rather than a broad one, so it is best studied in stages. Clocksin &amp; Mellish's [http://amzn.to/2GNAW9U Programming in Prolog] is the definitive introductory text on Prolog. Most importantly, it will help you to start programming straight away. == More Advanced Applications == I regard Peter Flach's [https://www.amazon.co.uk/Simply-Logical-Intelligent-Reasoning-Professional/dp/0471941522/278-2628466-8703061?tag=bindingtimeli-21 Simply Logical: Intelligent Reasoning by Example] as the best advanced text. It deals with both theoretical and practical aspects of logic programming but doesn't assume prior knowledge beyond that you will have gained from &quot;Programming in Prolog&quot;. It has an interactive edition at [http://book.simply-logical.space/ simply-logical.space] or you can download the programs in the book, and the book as a <abbr title="Portable Document Format">PDF</abbr> file, from the [http://people.cs.bris.ac.uk/~flach/SimplyLogical.html Simply Logical page at Bristol University]. == The Last Word == Robert Kowalski's classic [http://amzn.to/2EDfWSM Logic for Problem Solving] is essential reading for Prolog programmers. [http://amzn.to/2nGDf65 Logic for Problem Solving, Revisited] is a more recent, revised edition. The original book has been scanned into PDF format and can be downloaded from [http://www.doc.ic.ac.uk/~rak/ Robert Kowalski's homepage]. == Getting Technical == Performance and memory utilisation become important when Prolog is used to solve complex problems. David Harel's [http://amzn.to/2E2ooy5 Algorithmics] is a very accessible treatment of program behaviour. It isn't tied to one programming language, and the techniques described are readily applicable to Prolog programs. Richard O'Keefe's [http://amzn.to/2GI0dlX The Craft of Prolog] is a superb exposition of the techniques that can be employed to work ''with'' Prolog, rather than fighting against it, and the rationale behind them. efb703c1d058bc567ac4da6e9e8c24973e1eddd0 220 219 2018-05-06T00:45:15Z John 2 Reinstate short link to Simply Logical wikitext text/x-wiki __NOTOC__ Out of the many Prolog programming books that I have read, I consider these to be the best. == Starting Out == Prolog is a deep subject, rather than a broad one, so it is best studied in stages. Clocksin &amp; Mellish's [http://amzn.to/2GNAW9U Programming in Prolog] is the definitive introductory text on Prolog. Most importantly, it will help you to start programming straight away. == More Advanced Applications == I regard Peter Flach's [http://amzn.to/2nACWuu Simply Logical: Intelligent Reasoning by Example] as the best advanced text. It deals with both theoretical and practical aspects of logic programming but doesn't assume prior knowledge beyond that you will have gained from &quot;Programming in Prolog&quot;. It has an interactive edition at [http://book.simply-logical.space/ simply-logical.space] or you can download the programs in the book, and the book as a <abbr title="Portable Document Format">PDF</abbr> file, from the [http://people.cs.bris.ac.uk/~flach/SimplyLogical.html Simply Logical page at Bristol University]. == The Last Word == Robert Kowalski's classic [http://amzn.to/2EDfWSM Logic for Problem Solving] is essential reading for Prolog programmers. [http://amzn.to/2nGDf65 Logic for Problem Solving, Revisited] is a more recent, revised edition. The original book has been scanned into PDF format and can be downloaded from [http://www.doc.ic.ac.uk/~rak/ Robert Kowalski's homepage]. == Getting Technical == Performance and memory utilisation become important when Prolog is used to solve complex problems. David Harel's [http://amzn.to/2E2ooy5 Algorithmics] is a very accessible treatment of program behaviour. It isn't tied to one programming language, and the techniques described are readily applicable to Prolog programs. Richard O'Keefe's [http://amzn.to/2GI0dlX The Craft of Prolog] is a superb exposition of the techniques that can be employed to work ''with'' Prolog, rather than fighting against it, and the rationale behind them. b487d1bbc79da1dd0ea84bf707afefa82009fe62 221 220 2018-05-12T23:53:54Z John 2 /* More Advanced Applications */ wikitext text/x-wiki __NOTOC__ Out of the many Prolog programming books that I have read, I consider these to be the best. == Starting Out == Prolog is a deep subject, rather than a broad one, so it is best studied in stages. Clocksin &amp; Mellish's [http://amzn.to/2GNAW9U Programming in Prolog] is the definitive introductory text on Prolog. Most importantly, it will help you to start programming straight away. == More Advanced Applications == I regard Peter Flach's [http://amzn.to/2nACWuu Simply Logical: Intelligent Reasoning by Example] as the best advanced text. It deals with both theoretical and practical aspects of logic programming but doesn't assume prior knowledge beyond that you will have gained from &quot;Programming in Prolog&quot;. It has an interactive edition at [https://book.simply-logical.space/ simply-logical.space] or you can download the programs in the book, and the book as a <abbr title="Portable Document Format">PDF</abbr> file, from the [http://people.cs.bris.ac.uk/~flach/SimplyLogical.html Simply Logical page at Bristol University]. == The Last Word == Robert Kowalski's classic [http://amzn.to/2EDfWSM Logic for Problem Solving] is essential reading for Prolog programmers. [http://amzn.to/2nGDf65 Logic for Problem Solving, Revisited] is a more recent, revised edition. The original book has been scanned into PDF format and can be downloaded from [http://www.doc.ic.ac.uk/~rak/ Robert Kowalski's homepage]. == Getting Technical == Performance and memory utilisation become important when Prolog is used to solve complex problems. David Harel's [http://amzn.to/2E2ooy5 Algorithmics] is a very accessible treatment of program behaviour. It isn't tied to one programming language, and the techniques described are readily applicable to Prolog programs. Richard O'Keefe's [http://amzn.to/2GI0dlX The Craft of Prolog] is a superb exposition of the techniques that can be employed to work ''with'' Prolog, rather than fighting against it, and the rationale behind them. d2305bf69d829228dc2cf1a6422e8f1fadb67f90 235 221 2019-11-08T20:25:53Z John 2 Update LfPS revisited link wikitext text/x-wiki __NOTOC__ Out of the many Prolog programming books that I have read, I consider these to be the best. == Starting Out == Prolog is a deep subject, rather than a broad one, so it is best studied in stages. Clocksin &amp; Mellish's [http://amzn.to/2GNAW9U Programming in Prolog] is the definitive introductory text on Prolog. Most importantly, it will help you to start programming straight away. == More Advanced Applications == I regard Peter Flach's [http://amzn.to/2nACWuu Simply Logical: Intelligent Reasoning by Example] as the best advanced text. It deals with both theoretical and practical aspects of logic programming but doesn't assume prior knowledge beyond that you will have gained from &quot;Programming in Prolog&quot;. It has an interactive edition at [https://book.simply-logical.space/ simply-logical.space] or you can download the programs in the book, and the book as a <abbr title="Portable Document Format">PDF</abbr> file, from the [http://people.cs.bris.ac.uk/~flach/SimplyLogical.html Simply Logical page at Bristol University]. == The Last Word == Robert Kowalski's classic [http://amzn.to/2EDfWSM Logic for Problem Solving] is essential reading for Prolog programmers. [https://www.amazon.co.uk/Problem-Solving-Revisited-Robert-Kowalski/dp/3837036294 Logic for Problem Solving, Revisited] is a more recent, revised edition. The original book has been scanned into PDF format and can be downloaded from [http://www.doc.ic.ac.uk/~rak/ Robert Kowalski's homepage]. == Getting Technical == Performance and memory utilisation become important when Prolog is used to solve complex problems. David Harel's [http://amzn.to/2E2ooy5 Algorithmics] is a very accessible treatment of program behaviour. It isn't tied to one programming language, and the techniques described are readily applicable to Prolog programs. Richard O'Keefe's [http://amzn.to/2GI0dlX The Craft of Prolog] is a superb exposition of the techniques that can be employed to work ''with'' Prolog, rather than fighting against it, and the rationale behind them. 475de821fd1a594564a23a3933586c4072eef183 236 235 2019-12-04T00:11:55Z John 2 Convert shortened Amazon links to https wikitext text/x-wiki __NOTOC__ Out of the many Prolog programming books that I have read, I consider these to be the best. == Starting Out == Prolog is a deep subject, rather than a broad one, so it is best studied in stages. Clocksin &amp; Mellish's [https://amzn.to/2GNAW9U Programming in Prolog] is the definitive introductory text on Prolog. Most importantly, it will help you to start programming straight away. == More Advanced Applications == I regard Peter Flach's [https://amzn.to/2nACWuu Simply Logical: Intelligent Reasoning by Example] as the best advanced text. It deals with both theoretical and practical aspects of logic programming but doesn't assume prior knowledge beyond that you will have gained from &quot;Programming in Prolog&quot;. It has an interactive edition at [https://book.simply-logical.space/ simply-logical.space] or you can download the programs in the book, and the book as a <abbr title="Portable Document Format">PDF</abbr> file, from the [http://people.cs.bris.ac.uk/~flach/SimplyLogical.html Simply Logical page at Bristol University]. == The Last Word == Robert Kowalski's classic [https://amzn.to/2EDfWSM Logic for Problem Solving] is essential reading for Prolog programmers. [https://www.amazon.co.uk/Problem-Solving-Revisited-Robert-Kowalski/dp/3837036294 Logic for Problem Solving, Revisited] is a more recent, revised edition. The original book has been scanned into PDF format and can be downloaded from [http://www.doc.ic.ac.uk/~rak/ Robert Kowalski's homepage]. == Getting Technical == Performance and memory utilisation become important when Prolog is used to solve complex problems. David Harel's [https://amzn.to/2E2ooy5 Algorithmics] is a very accessible treatment of program behaviour. It isn't tied to one programming language, and the techniques described are readily applicable to Prolog programs. Richard O'Keefe's [https://amzn.to/2GI0dlX The Craft of Prolog] is a superb exposition of the techniques that can be employed to work ''with'' Prolog, rather than fighting against it, and the rationale behind them. 2452dd994698d15003413455a39366c599f7ecc1 246 236 2021-02-07T17:03:44Z John 2 Replacing broken Amazon links with Worldcat links. wikitext text/x-wiki __NOTOC__ Out of the many Prolog programming books that I have read, I consider these to be the best. == Starting Out == Prolog is a deep subject, rather than a broad one, so it is best studied in stages. Clocksin &amp; Mellish's [https://www.worldcat.org/title/programming-in-prolog/oclc/1199008151/editions Programming in Prolog] is the definitive introductory text on Prolog. Most importantly, it will help you to start programming straight away. == More Advanced Applications == I regard Peter Flach's [https://www.worldcat.org/title/simply-logical-intelligent-reasoning-by-example/oclc/246150014/editions Simply Logical: Intelligent Reasoning by Example] as the best advanced text. It deals with both theoretical and practical aspects of logic programming but doesn't assume prior knowledge beyond that you will have gained from &quot;Programming in Prolog&quot;. It has an interactive edition at [https://book.simply-logical.space/ simply-logical.space] or you can download the programs in the book, and the book as a <abbr title="Portable Document Format">PDF</abbr> file, from the [http://people.cs.bris.ac.uk/~flach/SimplyLogical.html Simply Logical page at Bristol University]. == The Last Word == Robert Kowalski's classic [https://www.worldcat.org/title/logic-for-problem-solving/oclc/710744783/editions Logic for Problem Solving] is essential reading for Prolog programmers. [https://www.worldcat.org/title/logic-for-problem-solving-revisited/oclc/958465391/editions Logic for Problem Solving, Revisited] is a more recent, revised edition. The original book has been scanned into PDF format and can be downloaded from [http://www.doc.ic.ac.uk/~rak/ Robert Kowalski's homepage]. == Getting Technical == Performance and memory utilization become important when Prolog is used to solve complex problems. David Harel's [https://www.worldcat.org/title/algorithmics-the-spirit-of-computing/oclc/889969825/editions Algorithmics] is a very accessible treatment of program behaviour. It isn't tied to one programming language and the techniques described are readily applicable to Prolog programs. Richard O'Keefe's [https://www.worldcat.org/title/craft-of-prolog/oclc/1024831685/editions The Craft of Prolog] is a superb exposition of the techniques that can be employed to work ''with'' Prolog, rather than fighting against it, and the rationale behind them. 71e2fa4b4dc1635337b72a9892409773b4463932 249 246 2021-11-16T00:06:40Z John 2 The Simply Logical page at Bristol University has been marked as obsolete wikitext text/x-wiki __NOTOC__ Out of the many Prolog programming books that I have read, I consider these to be the best. == Starting Out == Prolog is a deep subject, rather than a broad one, so it is best studied in stages. Clocksin &amp; Mellish's [https://www.worldcat.org/title/programming-in-prolog/oclc/1199008151/editions Programming in Prolog] is the definitive introductory text on Prolog. Most importantly, it will help you to start programming straight away. == More Advanced Applications == I regard Peter Flach's [https://www.worldcat.org/title/simply-logical-intelligent-reasoning-by-example/oclc/246150014/editions Simply Logical: Intelligent Reasoning by Example] as the best advanced text. It deals with both theoretical and practical aspects of logic programming but doesn't assume prior knowledge beyond that you will have gained from &quot;Programming in Prolog&quot;. It has an interactive edition at [https://book.simply-logical.space/ simply-logical.space] or you can download the programs in the book, and the book as a <abbr title="Portable Document Format">PDF</abbr> file, from [https://github.com/simply-logical/ Simply Logical on GitHub]. == The Last Word == Robert Kowalski's classic [https://www.worldcat.org/title/logic-for-problem-solving/oclc/710744783/editions Logic for Problem Solving] is essential reading for Prolog programmers. [https://www.worldcat.org/title/logic-for-problem-solving-revisited/oclc/958465391/editions Logic for Problem Solving, Revisited] is a more recent, revised edition. The original book has been scanned into PDF format and can be downloaded from [http://www.doc.ic.ac.uk/~rak/ Robert Kowalski's homepage]. == Getting Technical == Performance and memory utilization become important when Prolog is used to solve complex problems. David Harel's [https://www.worldcat.org/title/algorithmics-the-spirit-of-computing/oclc/889969825/editions Algorithmics] is a very accessible treatment of program behaviour. It isn't tied to one programming language and the techniques described are readily applicable to Prolog programs. Richard O'Keefe's [https://www.worldcat.org/title/craft-of-prolog/oclc/1024831685/editions The Craft of Prolog] is a superb exposition of the techniques that can be employed to work ''with'' Prolog, rather than fighting against it, and the rationale behind them. 851f9117af9f71f042f410f515b6d2c019d66c1f 0 19 222 198 2018-05-15T21:38:41Z John 2 /* XML */ wikitext text/x-wiki __NOTOC__ == Prolog for the Worldwide Web == For a Prolog programmer, to suggest that Prolog is an ideal language for web-based applications is to invite the comment that, &ldquo;if you have only a hammer, everything looks like a nail&rdquo;. However, the correspondences between Prolog behaviour and HTTP, and Prolog data-structures and XML are so strong that it's fair to say that ''if Prolog is a hand, the Worldwide Web is a glove.'' == HTTP == Consider that Prolog's default behaviour is query-solving &ndash; where a query is posed for which arbitrarily many answers (solutions) may be returned. This can be mapped to HTTP's request/response mechanism straightforwardly: === HTTP GET === The HTTP GET verb has a clear correspondence with Prolog's notion of a query. In fact, Prolog can be used directly as part of a request URI, acting as a lightweight data structuring mechanism. However, HTTP requires each request/response to be deterministic, which suggests that ''all'' the solutions for a non-deterministic query should be returned. The solutions can be formatted as an XHTML list or table, for example. === Caching === Prolog programming allows for the 'caching' of expensive results using lemmas, a technique used in the solution of the [[Mister X#Lemmas|Mister X]] puzzle, for example. HTTP's 'HEAD' verb and GET with &ldquo;If-Modified-Since&rdquo; support caching mechanisms, primarily to save communications bandwidth. The integration of Prolog lemmas with HTTP's caching methods can save both bandwidth and recomputation through a single mechanism, enabling the creation of robust distributed applications with a minimum of fuss. === HTTP POST === When using Prolog with HTTP, the POST verb should be reserved for passing clauses from the client to the server, to update the server, not for queries. The fact that Prolog is a good format for including structured (composite) data items as part of a URI can obviate some inappropriate uses of HTTP's POST verb, by allowing more complex terms in GET requests. == XML == HTTP services in which both the client and server are Prolog programs can gain efficiency by exchanging Prolog terms in URIs and results, using Prolog's term I/O facilities. However, XML is becoming established as the preferred format for data exchange in heterogeneous distributed applications. XML data is represented easily in Prolog, and vice versa, because both use tree-structured data exclusively. Because Prolog is a very high-level language, it is more flexible and more powerful than [https://www.w3.org/TR/xslt/all/ XSLT]. In particular, it seems to be very much easier to create robust and reliable transformations with Prolog, i.e. ones that produce only valid output for any valid input. ===xml.pl=== xml.pl is a module for [[parsing XML with Prolog]]. It has been placed in the public domain to encourage the use of Prolog with XML. ==PiLLoW== The [http://cliplab.org/miscdocs/pillow/pillow.html PiLLoW] library provides predicates for developing HTTP client and server applications. For client applications, it provides mechanisms to retrieve HTML files and to parse HTML into useful Prolog terms. For server applications, it provides a predicate to access CGI query parameters so that a Prolog application can be used to handle form input directly i.e. without additional scripting. Additionally, HTML parsing supports the reverse translation of terms into HTML so that forms can be generated. See also, [[Porting PiLLoW to Quintus Prolog]]. a6417e54b32d870f28b2fde09d2847bafbcd3bcb 241 222 2020-03-27T22:02:04Z John 2 Temporarily diverting XSLT link. wikitext text/x-wiki __NOTOC__ == Prolog for the Worldwide Web == For a Prolog programmer, to suggest that Prolog is an ideal language for web-based applications is to invite the comment that, &ldquo;if you have only a hammer, everything looks like a nail&rdquo;. However, the correspondences between Prolog behaviour and HTTP, and Prolog data-structures and XML are so strong that it's fair to say that ''if Prolog is a hand, the Worldwide Web is a glove.'' == HTTP == Consider that Prolog's default behaviour is query-solving &ndash; where a query is posed for which arbitrarily many answers (solutions) may be returned. This can be mapped to HTTP's request/response mechanism straightforwardly: === HTTP GET === The HTTP GET verb has a clear correspondence with Prolog's notion of a query. In fact, Prolog can be used directly as part of a request URI, acting as a lightweight data structuring mechanism. However, HTTP requires each request/response to be deterministic, which suggests that ''all'' the solutions for a non-deterministic query should be returned. The solutions can be formatted as an XHTML list or table, for example. === Caching === Prolog programming allows for the 'caching' of expensive results using lemmas, a technique used in the solution of the [[Mister X#Lemmas|Mister X]] puzzle, for example. HTTP's 'HEAD' verb and GET with &ldquo;If-Modified-Since&rdquo; support caching mechanisms, primarily to save communications bandwidth. The integration of Prolog lemmas with HTTP's caching methods can save both bandwidth and recomputation through a single mechanism, enabling the creation of robust distributed applications with a minimum of fuss. === HTTP POST === When using Prolog with HTTP, the POST verb should be reserved for passing clauses from the client to the server, to update the server, not for queries. The fact that Prolog is a good format for including structured (composite) data items as part of a URI can obviate some inappropriate uses of HTTP's POST verb, by allowing more complex terms in GET requests. == XML == HTTP services in which both the client and server are Prolog programs can gain efficiency by exchanging Prolog terms in URIs and results, using Prolog's term I/O facilities. However, XML is becoming established as the preferred format for data exchange in heterogeneous distributed applications. XML data is represented easily in Prolog, and vice versa, because both use tree-structured data exclusively. Because Prolog is a very high-level language, it is more flexible and more powerful than [[#XSLT Page Problem|XSLT]]. In particular, it seems to be very much easier to create robust and reliable transformations with Prolog, i.e. ones that produce only valid output for any valid input. ===xml.pl=== xml.pl is a module for [[parsing XML with Prolog]]. It has been placed in the public domain to encourage the use of Prolog with XML. ==PiLLoW== The [http://cliplab.org/miscdocs/pillow/pillow.html PiLLoW] library provides predicates for developing HTTP client and server applications. For client applications, it provides mechanisms to retrieve HTML files and to parse HTML into useful Prolog terms. For server applications, it provides a predicate to access CGI query parameters so that a Prolog application can be used to handle form input directly i.e. without additional scripting. Additionally, HTML parsing supports the reverse translation of terms into HTML so that forms can be generated. See also, [[Porting PiLLoW to Quintus Prolog]]. ===XSLT Page Problem=== As of 2020-03-27, the W3C's [https://www.w3.org/TR/xslt/all/ XSLT] page is invalid. On Windows, it can be repaired with: <code>curl "https://www.w3.org/TR/xslt/all/" | plxml - - | plxml - xslt.html</code> dce58aa9dbc9b0cd4b4699c18f665a65f4b2d71d 242 241 2020-03-28T21:46:12Z John 2 XSLT Page problem resolved wikitext text/x-wiki __NOTOC__ == Prolog for the Worldwide Web == For a Prolog programmer, to suggest that Prolog is an ideal language for web-based applications is to invite the comment that, &ldquo;if you have only a hammer, everything looks like a nail&rdquo;. However, the correspondences between Prolog behaviour and HTTP, and Prolog data-structures and XML are so strong that it's fair to say that ''if Prolog is a hand, the Worldwide Web is a glove.'' == HTTP == Consider that Prolog's default behaviour is query-solving &ndash; where a query is posed for which arbitrarily many answers (solutions) may be returned. This can be mapped to HTTP's request/response mechanism straightforwardly: === HTTP GET === The HTTP GET verb has a clear correspondence with Prolog's notion of a query. In fact, Prolog can be used directly as part of a request URI, acting as a lightweight data structuring mechanism. However, HTTP requires each request/response to be deterministic, which suggests that ''all'' the solutions for a non-deterministic query should be returned. The solutions can be formatted as an XHTML list or table, for example. === Caching === Prolog programming allows for the 'caching' of expensive results using lemmas, a technique used in the solution of the [[Mister X#Lemmas|Mister X]] puzzle, for example. HTTP's 'HEAD' verb and GET with &ldquo;If-Modified-Since&rdquo; support caching mechanisms, primarily to save communications bandwidth. The integration of Prolog lemmas with HTTP's caching methods can save both bandwidth and recomputation through a single mechanism, enabling the creation of robust distributed applications with a minimum of fuss. === HTTP POST === When using Prolog with HTTP, the POST verb should be reserved for passing clauses from the client to the server, to update the server, not for queries. The fact that Prolog is a good format for including structured (composite) data items as part of a URI can obviate some inappropriate uses of HTTP's POST verb, by allowing more complex terms in GET requests. == XML == HTTP services in which both the client and server are Prolog programs can gain efficiency by exchanging Prolog terms in URIs and results, using Prolog's term I/O facilities. However, XML is becoming established as the preferred format for data exchange in heterogeneous distributed applications. XML data is represented easily in Prolog, and vice versa, because both use tree-structured data exclusively. Because Prolog is a very high-level language, it is more flexible and more powerful than [https://www.w3.org/TR/xslt/all/ XSLT]. In particular, it seems to be very much easier to create robust and reliable transformations with Prolog, i.e. ones that produce only valid output for any valid input. ===xml.pl=== xml.pl is a module for [[parsing XML with Prolog]]. It has been placed in the public domain to encourage the use of Prolog with XML. ==PiLLoW== The [http://cliplab.org/miscdocs/pillow/pillow.html PiLLoW] library provides predicates for developing HTTP client and server applications. For client applications, it provides mechanisms to retrieve HTML files and to parse HTML into useful Prolog terms. For server applications, it provides a predicate to access CGI query parameters so that a Prolog application can be used to handle form input directly i.e. without additional scripting. Additionally, HTML parsing supports the reverse translation of terms into HTML so that forms can be generated. See also, [[Porting PiLLoW to Quintus Prolog]]. a6417e54b32d870f28b2fde09d2847bafbcd3bcb 0 3 230 150 2019-02-13T20:45:55Z John 2 The Wikipedia Prolog page is more current than the comp.lang.prolog FAQ. wikitext text/x-wiki ;John Fletcher's home on the Web __NOTOC__ &ldquo;Prolog is more than a language - it is a way of living :-)&rdquo; Bart Demoen ==Prolog== Ever since I first learned Prolog, more than 30 years ago, it has been my preferred programming language. ===Why use Prolog?=== Prolog is a tool for solving problems, rather than producing &ldquo;software products&rdquo;, and it will appeal to you if: * You want your programs to be readable, and to have a close correspondence with their specifications; * Statements like x = x + 1 offend your mathematical sensibility; * You like to develop programs incrementally &ndash; with an interactive top-level, interactive debugging, and the ability to test (execute) program fragments independently; * You want fewer lines of code and, therefore, fewer faults; * You prefer to work with a handful of big ideas, rather than a lot of small ones; If you want to find out about Prolog on the Web, you can start with the [[Wikipedia:Prolog|Wikipedia Prolog page]]. Other useful links include: * [[Logic Programming and the Internet]]. Prolog is unequalled as a language for expressing queries and integrity constraints, and for processing text, which make it an excellent choice for Internet applications. * XML documents and Prolog terms have the same &lsquo;tree&rsquo; structure, which makes it easy to program with XML and Prolog. My free code for [[Parsing XML with Prolog]] makes it even easier. * Recommended [[Prolog programming books]]. * My solutions to some puzzles in Prolog: ** [[The Water Jugs Problem]], ** [[The Counterfeit Coin Puzzle]], ** [[Cheating Linguists]]? ** [[Mister X]], ** [[Zoom Tracks]], ** [[Whodunit]]? Although Prolog is regarded as a niche language, it's a very versatile language. I believe that the programming languages used in 2050 will owe more to Prolog than to any other language. a5b617e19b2c00a3796c1dc96f7f0c6e8e5eba5d 4 7 232 142 2019-08-10T12:38:00Z John 2 The migration was completed years ago. wikitext text/x-wiki My site is presented via [https://www.mediawiki.org MediaWiki] because it is easy to maintain, and in the hope that navigation of the site will be already familiar to you. I hope that you like it. <blockquote> "Features like site maps , breadcrumbs , and other structural elements must become browser commands. Extracting information space navigation from the website will liberate users from the whims of Web designers and ensure consistent and standardized navigation features. The Web's history has shown that people use generic commands like the Back button far more than intermittent features, which, when they are available -- and users can actually find them -- tend to look and work differently on different sites." <cite>From [https://www.nngroup.com/articles/time-to-make-tech-work/ Time to Make Tech Work Jakob Nielsen's Alertbox: September 15, 2003]</cite> </blockquote> 9647238742b5d76341b665ec0dd1b9fc5a621699 233 232 2019-08-10T13:28:59Z John 2 Simpler wikitext text/x-wiki My site is presented using [https://www.mediawiki.org MediaWiki] because it is easy to maintain. Navigating the site may be familiar from [https://www.wikipedia.org Wikipedia]. I hope that you like it. <blockquote> "Features like site maps , breadcrumbs , and other structural elements must become browser commands. Extracting information space navigation from the website will liberate users from the whims of Web designers and ensure consistent and standardized navigation features. The Web's history has shown that people use generic commands like the Back button far more than intermittent features, which, when they are available -- and users can actually find them -- tend to look and work differently on different sites." <cite>From [https://www.nngroup.com/articles/time-to-make-tech-work/ Time to Make Tech Work Jakob Nielsen's Alertbox: September 15, 2003]</cite> </blockquote> ba68503ce83759c10ab15fd1eae681cf39482167 234 233 2019-08-10T13:29:37Z John 2 wikitext text/x-wiki My site is presented using [https://www.mediawiki.org MediaWiki] because it is easy to maintain. Navigating the site may be familiar to you from [https://www.wikipedia.org Wikipedia]. I hope that you like it. <blockquote> "Features like site maps , breadcrumbs , and other structural elements must become browser commands. Extracting information space navigation from the website will liberate users from the whims of Web designers and ensure consistent and standardized navigation features. The Web's history has shown that people use generic commands like the Back button far more than intermittent features, which, when they are available -- and users can actually find them -- tend to look and work differently on different sites." <cite>From [https://www.nngroup.com/articles/time-to-make-tech-work/ Time to Make Tech Work Jakob Nielsen's Alertbox: September 15, 2003]</cite> </blockquote> 0a24d13bfe09d1e8ddc8bc4f1df7184ff15ff88c 250 234 2021-12-19T20:20:19Z John 2 Mediawiki redirection wikitext text/x-wiki My site is presented using [https://www.mediawiki.org/wiki/MediaWiki MediaWiki] because it is easy to maintain. Navigating the site may be familiar to you from [https://www.wikipedia.org Wikipedia]. I hope that you like it. <blockquote> "Features like site maps , breadcrumbs , and other structural elements must become browser commands. Extracting information space navigation from the website will liberate users from the whims of Web designers and ensure consistent and standardized navigation features. The Web's history has shown that people use generic commands like the Back button far more than intermittent features, which, when they are available -- and users can actually find them -- tend to look and work differently on different sites." <cite>From [https://www.nngroup.com/articles/time-to-make-tech-work/ Time to Make Tech Work Jakob Nielsen's Alertbox: September 15, 2003]</cite> </blockquote> 59e693b81bf9a08a8faa4148867808cea5217f6c 0 17 252 244 2022-03-23T22:34:17Z John 2 /* Link to html-tidy.org */ wikitext text/x-wiki __NOTOC__ == Terms and Conditions == This program is offered free of charge as unsupported source code. You may use it, copy it, distribute it, modify it or sell it without restriction. I hope that it will be useful to you, but it is provided &quot;as is&quot; without any warranty express or implied, including but not limited to the warranty of non-infringement and the implied warranties of merchantability and fitness for a particular purpose. == Download == <pre>Current Version: XML Module 3.7 released 2014/07/09 Windows application plxml 5.0 released 2020/03/27 </pre> [https://binding-time.co.uk/download/xmlpl.tar.gz Download the source code] in tar.gz format (21KB) [https://binding-time.co.uk/download/xmlpl.zip Download the source code and Windows application] as a ZIP file (436KB). ''UTF-8 XML output &ndash; supporting non-ASCII Unicode characters in comments and CDATA sections.'' == Extracting the files == Unzip the files to create a folder structure as follows: <pre>+---bin | | plxml.exe : Application | | libpl.dll : Quintus Prolog support DLL | | libqp.dll : &quot; &quot; &quot; &quot; | | qpconsole.dll : &quot; &quot; &quot; &quot; | | qpeng.dll : &quot; &quot; &quot; &quot; | +---source | xml.pl : Quintus Prolog module wrapper | xml.iso.pl : ISO Prolog module wrapper | xml.lpa.pl : LPA Prolog wrapper | xml_driver.pl : Driver | xml_acquisition.pl : Chars -&gt; Document parsing | xml_generation.pl : Document -&gt; Chars parsing | xml_diagnosis.pl : Document -&gt; Chars parsing exception | xml_pp.pl : Document pretty-printing | xml_utilities.pl : Shared code</pre> == The Source Code (xml.pl) == xml is intended to be a modular module: it should be easy to build a program that can output XML, but not read it, or vice versa. Similarly, you may be happy to dispense with diagnosis once you are sure that your code will only try to make valid calls to xml_parse/2. It is intended that the code should be very portable too. Clearly, some small changes will be needed between platforms, but these should be limited to the top-level wrapper file which contains the potentially non-portable code. It is suggested that you name the wrapper file you need as xml.pl == Using plxml.exe == The application and the DLLs should reside in the same directory, unless you have a good reason to do something different. The application is invoked with two file names as operands, i.e. plxml [-(c|p|a)*] INPUT OUTPUT If INPUT contains a Prolog xml/2 clause, OUTPUT is written as the corresponding XML. If INPUT contains a Prolog malformed/2 clause, OUTPUT is written as the corresponding XML with the unparsed/1 and out_of_context/1 terms written as CDATA. If INPUT is an XML file, OUTPUT is written as a Prolog xml/2 or malformed/2 clause. INPUT and/or OUTPUT may be &quot;-&quot; indicating stdin/stdout respectively. ; The -a option : allows unescaped &amp; (ampersand) characters to occur in PCDATA; ; The -p option : preserves whitespace; ; The -c option : causes prefixes to be removed from attribute names if the explicitly denoted namespace is the same as that of the containing tag (XML input only); Plxml's Prolog output is compatible with [https://www.lpa.co.uk/ LPA Prolog]. Specifically, strings containing ~ (tilde) characters are output as lists of character codes. === Using plxml as a development tool === A common use of xml.pl is to populate template XML documents with answers from a Prolog application. A nice approach is to design a prototype document and then translate this into an xml/2 term with plxml. For example, a prototype HTML page could be produced with a WYSIWYG XHTML editor. Alternatively, if your editor produces plain HTML, you can use plxml in combination with [http://www.html-tidy.org/ HTML Tidy] e.g. tidy -asxhtml -ascii [HTMLFile] | plxml - [PLFile] Similarly, during prototyping/early development it may be convenient to use plxml as the interface, rather than integrating xml.pl. === Using plxml to repair XML === plxml can sometimes repair broken XML: plxml -ac [Broken XML] - | plxml - [Fixed XML] === Character Encoding === By default, plxml can accept input encoded as UTF-8 or UTF-16, which encompasses plain 7-bit ASCII. The iso-8859-1, iso-8859-2, iso-8859-15 and windows-1252 8-bit encodings are supported, but they must be identified correctly in the signature of the XML document. With the exception of comments and CDATA sections, xml.pl and plxml output a plain ASCII encoding with the following properties: * In all character data, the characters &amp; &lt; and &gt; are encoded as &amp;amp; &amp;lt; and &amp;gt; respectively. * In non-parsed character data, such as ''Attribute Values'', the characters &quot; and ' are encoded as &amp;quot; and &amp;apos; respectively. * Any character codes &gt; 127 are output as decimal character entities e.g. 160 as &amp;#160;. Only [https://www.w3.org/TR/xml/#NT-Char character codes allowed by the XML specification] are encoded by xml_parse/[2,3]. From version 5.0, plxml XML output is encoded as UTF-8. 74dced4db85c91bd0e16e475f6331ba9bfa7cb25 262 252 2022-08-02T20:05:50Z John 2 /* Updating link to HTTPS */ wikitext text/x-wiki __NOTOC__ == Terms and Conditions == This program is offered free of charge as unsupported source code. You may use it, copy it, distribute it, modify it or sell it without restriction. I hope that it will be useful to you, but it is provided &quot;as is&quot; without any warranty express or implied, including but not limited to the warranty of non-infringement and the implied warranties of merchantability and fitness for a particular purpose. == Download == <pre>Current Version: XML Module 3.7 released 2014/07/09 Windows application plxml 5.0 released 2020/03/27 </pre> [https://binding-time.co.uk/download/xmlpl.tar.gz Download the source code] in tar.gz format (21KB) [https://binding-time.co.uk/download/xmlpl.zip Download the source code and Windows application] as a ZIP file (436KB). ''UTF-8 XML output &ndash; supporting non-ASCII Unicode characters in comments and CDATA sections.'' == Extracting the files == Unzip the files to create a folder structure as follows: <pre>+---bin | | plxml.exe : Application | | libpl.dll : Quintus Prolog support DLL | | libqp.dll : &quot; &quot; &quot; &quot; | | qpconsole.dll : &quot; &quot; &quot; &quot; | | qpeng.dll : &quot; &quot; &quot; &quot; | +---source | xml.pl : Quintus Prolog module wrapper | xml.iso.pl : ISO Prolog module wrapper | xml.lpa.pl : LPA Prolog wrapper | xml_driver.pl : Driver | xml_acquisition.pl : Chars -&gt; Document parsing | xml_generation.pl : Document -&gt; Chars parsing | xml_diagnosis.pl : Document -&gt; Chars parsing exception | xml_pp.pl : Document pretty-printing | xml_utilities.pl : Shared code</pre> == The Source Code (xml.pl) == xml is intended to be a modular module: it should be easy to build a program that can output XML, but not read it, or vice versa. Similarly, you may be happy to dispense with diagnosis once you are sure that your code will only try to make valid calls to xml_parse/2. It is intended that the code should be very portable too. Clearly, some small changes will be needed between platforms, but these should be limited to the top-level wrapper file which contains the potentially non-portable code. It is suggested that you name the wrapper file you need as xml.pl == Using plxml.exe == The application and the DLLs should reside in the same directory, unless you have a good reason to do something different. The application is invoked with two file names as operands, i.e. plxml [-(c|p|a)*] INPUT OUTPUT If INPUT contains a Prolog xml/2 clause, OUTPUT is written as the corresponding XML. If INPUT contains a Prolog malformed/2 clause, OUTPUT is written as the corresponding XML with the unparsed/1 and out_of_context/1 terms written as CDATA. If INPUT is an XML file, OUTPUT is written as a Prolog xml/2 or malformed/2 clause. INPUT and/or OUTPUT may be &quot;-&quot; indicating stdin/stdout respectively. ; The -a option : allows unescaped &amp; (ampersand) characters to occur in PCDATA; ; The -p option : preserves whitespace; ; The -c option : causes prefixes to be removed from attribute names if the explicitly denoted namespace is the same as that of the containing tag (XML input only); Plxml's Prolog output is compatible with [https://www.lpa.co.uk/ LPA Prolog]. Specifically, strings containing ~ (tilde) characters are output as lists of character codes. === Using plxml as a development tool === A common use of xml.pl is to populate template XML documents with answers from a Prolog application. A nice approach is to design a prototype document and then translate this into an xml/2 term with plxml. For example, a prototype HTML page could be produced with a WYSIWYG XHTML editor. Alternatively, if your editor produces plain HTML, you can use plxml in combination with [https://www.html-tidy.org/ HTML Tidy] e.g. tidy -asxhtml -ascii [HTMLFile] | plxml - [PLFile] Similarly, during prototyping/early development it may be convenient to use plxml as the interface, rather than integrating xml.pl. === Using plxml to repair XML === plxml can sometimes repair broken XML: plxml -ac [Broken XML] - | plxml - [Fixed XML] === Character Encoding === By default, plxml can accept input encoded as UTF-8 or UTF-16, which encompasses plain 7-bit ASCII. The iso-8859-1, iso-8859-2, iso-8859-15 and windows-1252 8-bit encodings are supported, but they must be identified correctly in the signature of the XML document. With the exception of comments and CDATA sections, xml.pl and plxml output a plain ASCII encoding with the following properties: * In all character data, the characters &amp; &lt; and &gt; are encoded as &amp;amp; &amp;lt; and &amp;gt; respectively. * In non-parsed character data, such as ''Attribute Values'', the characters &quot; and ' are encoded as &amp;quot; and &amp;apos; respectively. * Any character codes &gt; 127 are output as decimal character entities e.g. 160 as &amp;#160;. Only [https://www.w3.org/TR/xml/#NT-Char character codes allowed by the XML specification] are encoded by xml_parse/[2,3]. From version 5.0, plxml XML output is encoded as UTF-8. f03cf851e1e6ef069edd63ddf6af8632f0b9baba 0 18 253 203 2022-08-01T19:11:09Z John 2 /* XMP link updated to https */ wikitext text/x-wiki __NOTOC__ The following is a complete example to illustrate how the xml.pl module can be used. It exercises both the input and output parsing modes of <code>xml_parse/[2,3]</code>, and illustrates the use of <code>xml_subterm/2</code> to access the nodes of a &ldquo;document value model&rdquo;. It's written for Quintus Prolog, but should port to other Prologs easily. ====test( +QueryId )==== The <code>test/1</code> predicate is the entry-point of the program and executes a Prolog implementation of a Query from [https://www.w3.org/TR/xquery-use-cases/#xmp Use Case &ldquo;XMP&rdquo;: Experiences and Exemplars], in the W3C's XML Query Use Cases, which &ldquo;contains several example queries that illustrate requirements gathered from the database and document communities&rdquo;. <var>QueryId</var> is one of <code>q1</code>...<code>q12</code> selecting which of the 12 use cases is executed. The XML output is written to the file [QueryId].xml in the current directory. <code>xml_pp/1</code> is used to display the resulting &ldquo;document value model&rdquo; data-structures on the user output (stdout) stream. <pre class="prolog">test( Query ) :- xml_query( Query, ResultElement ), % Parse output XML into the Output chars xml_parse( Output, xml([], [ResultElement]) ), absolute_file_name( Query, [extensions(xml)], OutputFile ), % Write OutputFile from the Output list of chars tell( OutputFile ), put_chars( Output ), told, % Pretty print OutputXML write( 'Output XML' ), nl, xml_pp( xml([], [ResultElement]) ).</pre> ====xml_query( +QueryNo, ?OutputXML )==== when <var>OutputXML</var> is an XML Document Value Model produced by running an example, identified by <var>QueryNo</var>, taken from the XML Query &ldquo;XMP&rdquo; use case. ===Q1=== List books published by Addison-Wesley after 1991, including their year and title. <pre class="prolog">xml_query( q1, element(bib, [], Books) ) :- element_name( Title, title ), element_name( Publisher, publisher ), input_document( 'bib.xml', Bibliography ), findall( element(book, [year=Year], [Title]), ( xml_subterm( Bibliography, element(book, Attributes, Content) ), xml_subterm( Content, Publisher ), xml_subterm( Publisher, Text ), text_value( Text, "Addison-Wesley" ), member( year=Year, Attributes ), number_codes( YearNo, Year ), YearNo > 1991, xml_subterm( Content, Title ) ), Books ).</pre> ===Q2=== Create a flat list of all the title-author pairs, with each pair enclosed in a &ldquo;result&rdquo; element. <pre class="prolog">xml_query( q2, element(results, [], Results) ) :- element_name( Title, title ), element_name( Author, author ), element_name( Book, book ), input_document( 'bib.xml', Bibliography ), findall( element(result, [], [Title,Author]), ( xml_subterm( Bibliography, Book ), xml_subterm( Book, Title ), xml_subterm( Book, Author ) ), Results ).</pre> ===Q3=== For each book in the bibliography, list the title and authors, grouped inside a &ldquo;result&rdquo; element. <pre class="prolog">xml_query( q3, element(results, [], Results) ) :- element_name( Title, title ), element_name( Author, author ), element_name( Book, book ), input_document( 'bib.xml', Bibliography ), findall( element(result, [], [Title|Authors]), ( xml_subterm( Bibliography, Book ), xml_subterm( Book, Title ), findall( Author, xml_subterm(Book, Author), Authors ) ), Results ).</pre> ===Q4=== For each author in the bibliography, list the author's name and the titles of all books by that author, grouped inside a &ldquo;result&rdquo; element. <pre class="prolog">xml_query( q4, element(results, [], Results) ) :- element_name( Title, title ), element_name( Author, author ), element_name( Book, book ), input_document( 'bib.xml', Bibliography ), findall( Author, xml_subterm(Bibliography, Author), AuthorBag ), sort( AuthorBag, Authors ), findall( element(result, [], [Author|Titles]), ( member( Author, Authors ), findall( Title, ( xml_subterm( Bibliography, Book ), xml_subterm( Book, Author ), xml_subterm( Book, Title ) ), Titles ) ), Results ).</pre> ===Q5=== For each book found at both bn.com and amazon.com, list the title of the book and its price from each source. <pre class="prolog">xml_query( q5, element('books-with-prices', [], BooksWithPrices) ) :- element_name( Title, title ), element_name( Book, book ), element_name( Review, entry ), input_document( 'bib.xml', Bibliography ), input_document( 'reviews.xml', Reviews ), findall( element('book-with-prices', [], [ Title, element('price-bn',[], BNPrice ), element('price-amazon',[], AmazonPrice ) ] ), ( xml_subterm( Bibliography, Book ), xml_subterm( Book, Title ), xml_subterm( Reviews, Review ), xml_subterm( Review, Title ), xml_subterm( Book, element(price,_, BNPrice) ), xml_subterm( Review, element(price,_, AmazonPrice) ) ), BooksWithPrices ).</pre> ===Q6=== For each book that has at least one author, list the title and first two authors, and an empty &ldquo;et-al&rdquo; element if the book has additional authors. <pre class="prolog">xml_query( q6, element(bib, [], Results) ) :- element_name( Title, title ), element_name( Author, author ), element_name( Book, book ), input_document( 'bib.xml', Bibliography ), findall( element(book, [], [Title,FirstAuthor|Authors]), ( xml_subterm( Bibliography, Book ), xml_subterm( Book, Title ), findall( Author, xml_subterm(Book, Author), [FirstAuthor|Others] ), other_authors( Others, Authors ) ), Results ).</pre> ===Q7=== List the titles and years of all books published by Addison-Wesley after 1991, in alphabetic order. <pre class="prolog">xml_query( q7, element(bib, [], Books) ) :- element_name( Title, title ), element_name( Publisher, publisher ), input_document( 'bib.xml', Bibliography ), findall( Title-element(book, [year=Year], [Title]), ( xml_subterm( Bibliography, element(book, Attributes, Book) ), xml_subterm( Book, Publisher ), xml_subterm( Publisher, Text ), text_value( Text, "Addison-Wesley" ), member( year=Year, Attributes ), number_codes( YearNo, Year ), YearNo > 1991, xml_subterm( Book, Title ) ), TitleBooks ), keysort( TitleBooks, TitleBookSet ), range( TitleBookSet, Books ).</pre> ===Q8=== Find books in which the name of some element ends with the string &ldquo;or&rdquo; and the same element contains the string &ldquo;Suciu&rdquo; somewhere in its content. For each such book, return the title and the qualifying element. <pre class="prolog">xml_query( q8, element(bib, [], Books) ) :- element_name( Title, title ), element_name( Book, book ), element_name( QualifyingElement, QualifyingName ), append( "Suciu", _Back, Suffix ), input_document( 'bib.xml', Bibliography ), findall( element(book, [], [Title,QualifyingElement]), ( xml_subterm( Bibliography, Book ), xml_subterm( Book, QualifyingElement ), atom_codes( QualifyingName, QNChars ), append( _QNPrefix, "or", QNChars ), xml_subterm( QualifyingElement, TextItem ), text_value( TextItem, TextValue ), append( _Prefix, Suffix, TextValue ), xml_subterm( Book, Title ) ), Books ).</pre> ===Q9=== In the document &ldquo;books.xml&rdquo;, find all section or chapter titles that contain the word &ldquo;XML&rdquo;, regardless of the level of nesting. <pre class="prolog">xml_query( q9, element(results, [], Titles) ) :- element_name( Title, title ), append( "XML", _Back, Suffix ), input_document( 'books.xml', Books ), findall( Title, ( xml_subterm( Books, Title ), xml_subterm( Title, TextItem ), text_value( TextItem, TextValue ), append( _Prefix, Suffix, TextValue ) ), Titles ).</pre> ===Q10=== In the document &ldquo;prices.xml&rdquo;, find the minimum price for each book, in the form of a &ldquo;minprice&rdquo; element with the book title as its title attribute. <pre class="prolog">xml_query( q10, element(results, [], MinPrices) ) :- element_name( Title, title ), element_name( Price, price ), input_document( 'prices.xml', Prices ), findall( Title, xml_subterm(Prices, Title), TitleBag ), sort( TitleBag, TitleSet ), element_name( Book, book ), findall( element(minprice, [title=TitleString], [MinPrice]), ( member( Title, TitleSet ), xml_subterm( Title, TitleText ), text_value( TitleText, TitleString ), findall( PriceValue-Price, ( xml_subterm( Prices, Book ), xml_subterm( Book, Title ), xml_subterm( Book, Price ), xml_subterm( Price, Text ), text_value( Text, PriceChars ), number_codes( PriceValue, PriceChars ) ), PriceValues ), minimum( PriceValues, PriceValue-MinPrice ) ), MinPrices ).</pre> ===Q11=== For each book with an author, return the book with its title and authors. For each book with an editor, return a reference with the book title and the editor's affiliation. <pre class="prolog">xml_query( q11, element(bib, [], Results) ) :- element_name( Title, title ), element_name( Author, author ), element_name( Book, book ), element_name( Editor, editor ), element_name( Affiliation, affiliation ), input_document( 'bib.xml', Bibliography ), findall( element(book, [], [Title,FirstAuthor|Authors]), ( xml_subterm( Bibliography, Book ), xml_subterm( Book, Title ), findall( Author, xml_subterm(Book, Author), [FirstAuthor|Authors] ) ), Books ), findall( element(reference, [], [Title,Affiliation]), ( xml_subterm( Bibliography, Book ), xml_subterm( Book, Title ), xml_subterm( Book, Editor ), xml_subterm( Editor, Affiliation ) ), References ), append( Books, References, Results ).</pre> ===Q12=== Find pairs of books that have different titles but the same set of authors (possibly in a different order). <pre class="prolog">xml_query( q12, element(bib, [], Pairs) ) :- element_name( Author, author ), element_name( Book1, book ), element_name( Book2, book ), element_name( Title1, title ), element_name( Title2, title ), input_document( 'bib.xml', Bibliography ), findall( element('book-pair', [], [Title1,Title2]), ( xml_subterm( Bibliography, Book1 ), findall( Author, xml_subterm(Book1, Author), AuthorBag1 ), sort( AuthorBag1, AuthorSet ), xml_subterm( Bibliography, Book2 ), Book2 @< Book1, findall( Author, xml_subterm(Book2, Author), AuthorBag2 ), sort( AuthorBag2, AuthorSet ), xml_subterm( Book1, Title1 ), xml_subterm( Book2, Title2 ) ), Pairs ).</pre> == Auxiliary Predicates == <pre class="prolog">other_authors( [], [] ). other_authors( [Author|Authors], [Author|EtAl] ) :- et_al( Authors, EtAl ). et_al( [], [] ). et_al( [_|_], [element('et-al',[],[])] ). text_value( [pcdata(Text)], Text ). text_value( [cdata(Text)], Text ). element_name( element(Name, _Attributes, _Content), Name ).</pre> ====range( +Pairs, ?Range )==== when <var>Pairs</var> is a list of key-datum pairs and <var>Range</var> is the list of data. <pre class="prolog">range( [], [] ). range( [_Key-Datum|Pairs], [Datum|Data] ) :- range( Pairs, Data ).</pre> ====minimum( +List, ?Min )==== is true if <var>Min</var> is the least member of <var>List</var> in the standard order. <pre class="prolog">minimum( [H|T], Min ):- minimum1( T, H, Min ). minimum1( [], Min, Min ). minimum1( [H|T], Min0, Min ) :- compare( Relation, H, Min0 ), minimum2( Relation, H, Min0, T, Min ). minimum2( '=', Min0, Min0, T, Min ) :- minimum1( T, Min0, Min ). minimum2( '<', Min0, _Min1, T, Min ) :- minimum1( T, Min0, Min ). minimum2( '>', _Min0, Min1, T, Min ) :- minimum1( T, Min1, Min ).</pre> ====input_document( +File, ?XML )==== reads <var>File</var> and parses the input into the &ldquo;Document Value Model&rdquo; <var>XML</var>. <pre class="prolog">input_document( File, XML ) :- % Read InputFile as a list of chars see( File ), get_chars( Input ), seen, % Parse the Input chars into the term XML xml_parse( Input, XML ).</pre> Load the [[XML Module]]. <pre class="prolog">:- use_module( xml ).</pre> Load a small library of [[Puzzle Utilities]]. <pre class="prolog"> :- ensure_loaded( misc ). </pre> Download a 5Kb tar.gz format [https://binding-time.co.uk/download/xml_example.tar.gz file containing this program with input and output data]. a548acea0a43df30e2eb665e2533d24b41def943 0 16 254 251 2022-08-01T19:13:55Z John 2 /* SVG link updated to https. */ wikitext text/x-wiki __NOTOC__ <blockquote> &ldquo;I have a hard time arguing that anything in XML is generically useful any more except for the basic syntax, which lets us apply some very handy low-level tools like parsers and XSLT. The rest (XLink, schemas, etc.) has been a pointless trip into complexity.&rdquo; <cite>[https://lists.w3.org/Archives/Public/www-tag/2002Sep/0303.html Simon St.Laurent]</cite> </blockquote> <blockquote> &ldquo;My own experience is that having Prolog, Scheme, and Haskell available it'll take a gun pointed at my head or an extremely large bribe to make me use XSLT for anything.&rdquo; <cite>[http://cliplab.org/Mail/ciao-users/2001/000206.html Richard A. O'Keefe]</cite> </blockquote> ==Background== xml.pl is a module for parsing XML with Prolog, which provides Prolog applications with a simple ''Document Value Model'' interface to XML documents. It has been used successfully in a number of applications. It supports a subset of XML suitable for XML Data and Worldwide Web applications but it is neither as strict nor as comprehensive as the [https://www.w3.org/TR/xml/ XML 1.0 Specification] mandates. * It is not as strict because, while the specification must eliminate ambiguities, not all errors need to be regarded as faults, and some reasonable examples of real XML usage would have to be rejected if they were. * It is not as comprehensive because, where the XML specification makes provision for more or less complete DTDs to be provided as part of a document, xml.pl actions the local definition of ENTITIES only. Other DTD extensions are treated as commentary. ===Download the [[XML Module]] (xml.pl and plxml)=== xml.pl and plxml, a small Windows application which embodies xml.pl, have been placed into the public domain to encourage the use of Prolog with XML. I hope that they will be useful to you, but they are not supported, and they are provided without any warranty of any kind. ==Specification== Three predicates are exported by the module: <code>xml_parse/[2,3]</code>, <code>xml_subterm/2</code> and <code>xml_pp/1</code> . ====xml_parse( {+Controls,} +?Chars, ?+Document )==== parses <var>Chars</var>, a list of character codes, to/from <var>Document</var>, a data structure of the form <code>xml(Attributes, Content)</code>, where: ''Attributes'' is a list of ''Name''=''CharData'' attributes from the (possibly implicit) XML signature of the document. ''Content'' is a (possibly empty) list comprising occurrences of: ; <code>pcdata(CharData)</code> : Text ; <code>comment(CharData)</code> : An XML comment; ; <code>namespace(URI, Prefix, Element)</code> : a Namespace ; <code>element(Tag, Attributes, Content)</code> : <Tag>..</Tag> encloses Content or <Tag/> if Content is empty <nowiki>[]</nowiki>. ; <code>instructions(Name, CharData)</code> : A [https://www.w3.org/TR/xml/#sec-pi Processing Instruction] ''<''?Name CharData?''>''; ; <code>cdata(CharData)</code> : <![CDATA[CharData]]> ; <code>doctype(Tag, DoctypeId)</code> : DTD <!DOCTYPE .. > The conversions are not completely symmetrical in that weaker XML is accepted than can be generated. Specifically, in-bound ''(Chars -> Document)'' parsing does not require strictly well-formed XML. If <var>Chars</var> does not represent well-formed XML, <var>Document</var> is instantiated to the term <code>malformed(Attributes, Content)</code>. The ''Content'' of a ''malformed/2'' structure can include: ; <code>unparsed( CharData )</code> : Text which has not been parsed ; <code>out_of_context(Tag)</code> : <Tag> is not closed in addition to the parsed-term types. Out-bound ''(<var>Document</var> -> <var>Chars</var>)'' parsing ''does'' require that <var>Document</var> defines well-formed XML. If an error is detected, a 'domain' exception is raised. The domain exception will attempt to identify the particular sub-term in error, and will list the ancestor elements of the sub-term in error as <code>Tag{(Id)}</code> terms - where ''Id'' is the value of any attribute named id. The <var>Controls</var> applying to in-bound ''(<var>Chars</var> -> <var>Document</var>)'' parsing are: ; <code>extended_characters(Boolean)</code> : Use the extended character entities for XHTML (default true). ; <code>format(Boolean)</code> : Remove layouts when no non-layout character data appears between elements (default true). ; <code>remove_attribute_prefixes(Boolean)</code> : Remove redundant prefixes from attributes - i.e. prefixes denoting the namespace of the parent element (default false). ; <code> allow_ampersand(Boolean) </code> : Allow unescaped ampersand characters (&) to occur in PCDATA (default false). For out-bound ''(<var>Document</var> -> <var>Chars</var>)'' parsing, the only available option is: ; <code>format(Boolean)</code> : Indent the element content, (default true) ===Types=== ; Tag : An atom naming an element ; Name : An atom, not naming an element ; URI : An atom giving the URI of a Namespace ; CharData : A "string": list of character codes. ; DoctypeId : one of: <code>public(CharData,&nbsp;CharData&nbsp;{,&nbsp;DTDLiterals})</code>, <code>system(CharData&nbsp;{,&nbsp;DTDLiterals})</code> or <code>local{(DTDLiterals)}</code> ; DTDLiterals : A non-empty list of <code>dtd_literal(CharData)</code> terms - e.g. [https://www.w3.org/TR/xml/#NT-AttlistDecl attribute-list declarations]. ; Boolean : one of <code>true</code> or <code>false</code> ====xml_subterm( +XMLTerm, ?Subterm )==== unifies <var>Subterm</var> with a sub-term of <var>XMLTerm</var>. This can be especially useful when trying to test or retrieve a deeply-nested subterm from a document, as demonstrated in the [[XML Query Use Cases with xml.pl]] examples. Note that <var>XMLTerm</var> is a sub-term of itself. ====xml_pp( +XMLDocument )==== "pretty prints" <var>XMLDocument</var> on the current output stream. ==Availability== On this site, you can download the [[XML Module]]. The module is also supplied as a library with the following Prologs: * It has been adapted for the [https://logtalk.org/ Logtalk Open source object-oriented extension to Prolog] by Paulo Moura. (See the folder "contributions/xml_parser" from release 2.29.1); * It is available in the [http://eclipseclp.org/ ECLiPSe Constraint Programming System], as a third-party library; * It has been ported to [[Wikipedia:B-Prolog|B-Prolog]] by Neng-Fa Zhou. * It has been adapted for [https://sicstus.sics.se/thirdparty.html SICStus Prolog] by Mats Carlsson. * It is included in [https://quintus.sics.se/ Quintus Prolog Release 3.5]. [[XML Query Use Cases with xml.pl]] provides examples of the ways that the code can be used. ==Features of xml.pl== The <code>xml/2</code> data structure has some useful properties. ===Reusability=== Using a native Prolog representation of XML, in which terms represent document 'nodes', makes the parser reusable for any XML application. In effect, xml.pl encapsulates the application-independent tasks of document parsing and generation, which is essential where documents have components from more than one Namespace. ===Same Structure=== The Prolog term representing a document has the same structure as the document itself, which makes the correspondence between the literal representation of the Prolog term and the XML source readily apparent. For example, this simple [https://www.w3.org/Graphics/SVG/ SVG] image: <pre class="xml"> <?xml version="1.0" standalone="no"?> <!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.0//EN" "http://www.w3.org/.../svg10.dtd" [ <!ENTITY redblue "fill: red; stroke: blue; stroke-width: 1"> ]> <svg xmlns="http://www.w3.org/2000/svg" width="500" height="500"> <circle cx=" 25 " cy=" 25 " r=" 24 " style="&redblue;"/> </svg> </pre> ... translates into this Prolog term: <pre class="prolog"> xml( [version="1.0", standalone="no"], [ doctype( svg, public( "-//W3C//DTD SVG 1.0//EN", "http://www.w3.org/.../svg10.dtd" ) ), namespace( 'http://www.w3.org/2000/svg', "", element( svg, [width="500", height="500"], [ element( circle, [cx="25", cy="25", r="24", style="fill: red; stroke: blue; stroke-width: 1"], [] ) ] ) ) ] ). </pre> ===Efficient Manipulation=== Each type of node in an XML document is represented by a different Prolog functor, while data, (PCDATA, CDATA and Attribute Values), are left as "strings", (lists of character codes). The use of distinct functors for mark-up structures enables the efficient recursive traversal of a document, while leaving the data as strings facilitates the application-specific parsing of data content. For example, to turn every CDATA node into a PCDATA node with tabs expanded into spaces: <pre class="prolog"> cdata_to_pcdata( cdata(CharsWithTabs), pcdata(CharsWithSpaces) ) :- tab_expansion( CharsWithTabs, CharsWithSpaces ). cdata_to_pcdata( xml(Attributes, Content1), xml(Attributes, Content2) ) :- cdata_to_pcdata( Content1, Content2 ). cdata_to_pcdata( namespace(URI,Pfx,Content1), namespace(URI,Pfx,Content2) ) :- cdata_to_pcdata( Content1, Content2 ). cdata_to_pcdata( element(Name,Atts,Content1), element(Name,Atts,Content2) ) :- cdata_to_pcdata( Content1, Content2 ). cdata_to_pcdata( [], [] ). cdata_to_pcdata( [H1|T1], [H2|T2] ) :- cdata_to_pcdata( H1, H2 ), cdata_to_pcdata( T1, T2 ). cdata_to_pcdata( pcdata(Chars), pcdata(Chars) ). cdata_to_pcdata( comment(Chars), comment(Chars) ). cdata_to_pcdata( instructions(Name, Chars), instructions(Name, Chars) ). cdata_to_pcdata( doctype(Tag, DoctypeId), doctype(Tag, DoctypeId) ). </pre> The above uses no 'cuts', but will not create any choice points with ground input. ===Elegance=== The resolution of entity references and the decomposition of the document into distinct nodes means that the calling application is not concerned with the occasionally messy syntax of XML documents. For example, the clean separation of namespace nodes means that Namespaces, which are useful in combining specifications developed separately, have similar usefulness in combining applications developed separately. 0feb575d6c398d78fb1509a69d60e24529859a7e 256 254 2022-08-02T19:46:50Z John 2 /* Updating links to HTTPS */ wikitext text/x-wiki __NOTOC__ <blockquote> &ldquo;I have a hard time arguing that anything in XML is generically useful any more except for the basic syntax, which lets us apply some very handy low-level tools like parsers and XSLT. The rest (XLink, schemas, etc.) has been a pointless trip into complexity.&rdquo; <cite>[https://lists.w3.org/Archives/Public/www-tag/2002Sep/0303.html Simon St.Laurent]</cite> </blockquote> <blockquote> &ldquo;My own experience is that having Prolog, Scheme, and Haskell available it'll take a gun pointed at my head or an extremely large bribe to make me use XSLT for anything.&rdquo; <cite>[https://cliplab.org/Mail/ciao-users/2001/000206.html Richard A. O'Keefe]</cite> </blockquote> ==Background== xml.pl is a module for parsing XML with Prolog, which provides Prolog applications with a simple ''Document Value Model'' interface to XML documents. It has been used successfully in a number of applications. It supports a subset of XML suitable for XML Data and Worldwide Web applications but it is neither as strict nor as comprehensive as the [https://www.w3.org/TR/xml/ XML 1.0 Specification] mandates. * It is not as strict because, while the specification must eliminate ambiguities, not all errors need to be regarded as faults, and some reasonable examples of real XML usage would have to be rejected if they were. * It is not as comprehensive because, where the XML specification makes provision for more or less complete DTDs to be provided as part of a document, xml.pl actions the local definition of ENTITIES only. Other DTD extensions are treated as commentary. ===Download the [[XML Module]] (xml.pl and plxml)=== xml.pl and plxml, a small Windows application which embodies xml.pl, have been placed into the public domain to encourage the use of Prolog with XML. I hope that they will be useful to you, but they are not supported, and they are provided without any warranty of any kind. ==Specification== Three predicates are exported by the module: <code>xml_parse/[2,3]</code>, <code>xml_subterm/2</code> and <code>xml_pp/1</code> . ====xml_parse( {+Controls,} +?Chars, ?+Document )==== parses <var>Chars</var>, a list of character codes, to/from <var>Document</var>, a data structure of the form <code>xml(Attributes, Content)</code>, where: ''Attributes'' is a list of ''Name''=''CharData'' attributes from the (possibly implicit) XML signature of the document. ''Content'' is a (possibly empty) list comprising occurrences of: ; <code>pcdata(CharData)</code> : Text ; <code>comment(CharData)</code> : An XML comment; ; <code>namespace(URI, Prefix, Element)</code> : a Namespace ; <code>element(Tag, Attributes, Content)</code> : <Tag>..</Tag> encloses Content or <Tag/> if Content is empty <nowiki>[]</nowiki>. ; <code>instructions(Name, CharData)</code> : A [https://www.w3.org/TR/xml/#sec-pi Processing Instruction] ''<''?Name CharData?''>''; ; <code>cdata(CharData)</code> : <![CDATA[CharData]]> ; <code>doctype(Tag, DoctypeId)</code> : DTD <!DOCTYPE .. > The conversions are not completely symmetrical in that weaker XML is accepted than can be generated. Specifically, in-bound ''(Chars -> Document)'' parsing does not require strictly well-formed XML. If <var>Chars</var> does not represent well-formed XML, <var>Document</var> is instantiated to the term <code>malformed(Attributes, Content)</code>. The ''Content'' of a ''malformed/2'' structure can include: ; <code>unparsed( CharData )</code> : Text which has not been parsed ; <code>out_of_context(Tag)</code> : <Tag> is not closed in addition to the parsed-term types. Out-bound ''(<var>Document</var> -> <var>Chars</var>)'' parsing ''does'' require that <var>Document</var> defines well-formed XML. If an error is detected, a 'domain' exception is raised. The domain exception will attempt to identify the particular sub-term in error, and will list the ancestor elements of the sub-term in error as <code>Tag{(Id)}</code> terms - where ''Id'' is the value of any attribute named id. The <var>Controls</var> applying to in-bound ''(<var>Chars</var> -> <var>Document</var>)'' parsing are: ; <code>extended_characters(Boolean)</code> : Use the extended character entities for XHTML (default true). ; <code>format(Boolean)</code> : Remove layouts when no non-layout character data appears between elements (default true). ; <code>remove_attribute_prefixes(Boolean)</code> : Remove redundant prefixes from attributes - i.e. prefixes denoting the namespace of the parent element (default false). ; <code> allow_ampersand(Boolean) </code> : Allow unescaped ampersand characters (&) to occur in PCDATA (default false). For out-bound ''(<var>Document</var> -> <var>Chars</var>)'' parsing, the only available option is: ; <code>format(Boolean)</code> : Indent the element content, (default true) ===Types=== ; Tag : An atom naming an element ; Name : An atom, not naming an element ; URI : An atom giving the URI of a Namespace ; CharData : A "string": list of character codes. ; DoctypeId : one of: <code>public(CharData,&nbsp;CharData&nbsp;{,&nbsp;DTDLiterals})</code>, <code>system(CharData&nbsp;{,&nbsp;DTDLiterals})</code> or <code>local{(DTDLiterals)}</code> ; DTDLiterals : A non-empty list of <code>dtd_literal(CharData)</code> terms - e.g. [https://www.w3.org/TR/xml/#NT-AttlistDecl attribute-list declarations]. ; Boolean : one of <code>true</code> or <code>false</code> ====xml_subterm( +XMLTerm, ?Subterm )==== unifies <var>Subterm</var> with a sub-term of <var>XMLTerm</var>. This can be especially useful when trying to test or retrieve a deeply-nested subterm from a document, as demonstrated in the [[XML Query Use Cases with xml.pl]] examples. Note that <var>XMLTerm</var> is a sub-term of itself. ====xml_pp( +XMLDocument )==== "pretty prints" <var>XMLDocument</var> on the current output stream. ==Availability== On this site, you can download the [[XML Module]]. The module is also supplied as a library with the following Prologs: * It has been adapted for the [https://logtalk.org/ Logtalk Open source object-oriented extension to Prolog] by Paulo Moura. (See the folder "contributions/xml_parser" from release 2.29.1); * It is available in the [https://eclipseclp.org/ ECLiPSe Constraint Programming System], as a third-party library; * It has been ported to [[Wikipedia:B-Prolog|B-Prolog]] by Neng-Fa Zhou. * It has been adapted for [https://sicstus.sics.se/thirdparty.html SICStus Prolog] by Mats Carlsson. * It is included in [https://quintus.sics.se/ Quintus Prolog Release 3.5]. [[XML Query Use Cases with xml.pl]] provides examples of the ways that the code can be used. ==Features of xml.pl== The <code>xml/2</code> data structure has some useful properties. ===Reusability=== Using a native Prolog representation of XML, in which terms represent document 'nodes', makes the parser reusable for any XML application. In effect, xml.pl encapsulates the application-independent tasks of document parsing and generation, which is essential where documents have components from more than one Namespace. ===Same Structure=== The Prolog term representing a document has the same structure as the document itself, which makes the correspondence between the literal representation of the Prolog term and the XML source readily apparent. For example, this simple [https://www.w3.org/Graphics/SVG/ SVG] image: <pre class="xml"> <?xml version="1.0" standalone="no"?> <!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.0//EN" "http://www.w3.org/.../svg10.dtd" [ <!ENTITY redblue "fill: red; stroke: blue; stroke-width: 1"> ]> <svg xmlns="http://www.w3.org/2000/svg" width="500" height="500"> <circle cx=" 25 " cy=" 25 " r=" 24 " style="&redblue;"/> </svg> </pre> ... translates into this Prolog term: <pre class="prolog"> xml( [version="1.0", standalone="no"], [ doctype( svg, public( "-//W3C//DTD SVG 1.0//EN", "http://www.w3.org/.../svg10.dtd" ) ), namespace( 'http://www.w3.org/2000/svg', "", element( svg, [width="500", height="500"], [ element( circle, [cx="25", cy="25", r="24", style="fill: red; stroke: blue; stroke-width: 1"], [] ) ] ) ) ] ). </pre> ===Efficient Manipulation=== Each type of node in an XML document is represented by a different Prolog functor, while data, (PCDATA, CDATA and Attribute Values), are left as "strings", (lists of character codes). The use of distinct functors for mark-up structures enables the efficient recursive traversal of a document, while leaving the data as strings facilitates the application-specific parsing of data content. For example, to turn every CDATA node into a PCDATA node with tabs expanded into spaces: <pre class="prolog"> cdata_to_pcdata( cdata(CharsWithTabs), pcdata(CharsWithSpaces) ) :- tab_expansion( CharsWithTabs, CharsWithSpaces ). cdata_to_pcdata( xml(Attributes, Content1), xml(Attributes, Content2) ) :- cdata_to_pcdata( Content1, Content2 ). cdata_to_pcdata( namespace(URI,Pfx,Content1), namespace(URI,Pfx,Content2) ) :- cdata_to_pcdata( Content1, Content2 ). cdata_to_pcdata( element(Name,Atts,Content1), element(Name,Atts,Content2) ) :- cdata_to_pcdata( Content1, Content2 ). cdata_to_pcdata( [], [] ). cdata_to_pcdata( [H1|T1], [H2|T2] ) :- cdata_to_pcdata( H1, H2 ), cdata_to_pcdata( T1, T2 ). cdata_to_pcdata( pcdata(Chars), pcdata(Chars) ). cdata_to_pcdata( comment(Chars), comment(Chars) ). cdata_to_pcdata( instructions(Name, Chars), instructions(Name, Chars) ). cdata_to_pcdata( doctype(Tag, DoctypeId), doctype(Tag, DoctypeId) ). </pre> The above uses no 'cuts', but will not create any choice points with ground input. ===Elegance=== The resolution of entity references and the decomposition of the document into distinct nodes means that the calling application is not concerned with the occasionally messy syntax of XML documents. For example, the clean separation of namespace nodes means that Namespaces, which are useful in combining specifications developed separately, have similar usefulness in combining applications developed separately. d287ac0bd06c3f9d44aa979457add5a32a392d08 0 15 255 202 2022-08-02T19:43:04Z John 2 /* Updating link to HTTPS */ wikitext text/x-wiki __NOTOC__ ==Problem Statement== <blockquote><div>Problem posted to [https://groups.google.com/forum/#!msg/comp.lang.prolog/h2wy7VjCdEI/BzD3yB88K7oJ comp.lang.prolog] by Nimesh777@aol.com</div> M has been murdered. A, B and C are suspects. * A says he is innocent, B was M's friend but C hated M. * B says that he was out of town on the day of the murder, besides he didn't even know M. * C says he is innocent but he saw A &amp; B with M just before the murder. Assuming that all except possibly the murderer are telling the truth, solve the crime. </blockquote> ==Solution== <blockquote cite=""> When you have eliminated the impossible, whatever remains, however improbable, must be the truth. <cite>[https://www.gutenberg.org/ebooks/2097 Sir Arthur Conan Doyle - The Sign of the Four]</cite> </blockquote> ==== solve_murder( ?Murderer ) ==== Solving the crime means finding the <var>Murderer</var>'s identity, such that the <var>Murderer</var>'s statement is the only one that is inconsistent with the statements of the other suspects. <pre class="prolog">solve_murder( Murderer ) :- unique_solution( murderer( Murderer ) ).</pre> Firstly, the suspects' statements are formalized: <pre class="prolog">statement( a ) --> [innocent(a),friend(b,m),hates(c,m)]. statement( b ) --> [alibi(b),not_know(b,m)]. statement( c ) --> [innocent(c),with(c,m),with(b,m),with(a,m)]. statements( [] ) --> []. statements( [Witness|Witnesses] ) --> statement( Witness ), statements( Witnesses ).</pre> Then we define mutual-exclusivity between assertions. <pre class="prolog">mutually_exclusive( [friend(X,Y), hates(X,Y), not_know(X,Y)] ). mutually_exclusive( [innocent(X), guilty(X)] ). mutually_exclusive( [alibi(X), with(X,m)] ). mutually_exclusive( [alibi(X), with(m,X)] ). mutually_exclusive( [alibi(X), guilty(X)] ).</pre> The murderer is identified by showing that the statements of the other suspects (witnesses) are consistent with each other, and with the murderer being guilty. <pre class="prolog">murderer( Murderer ) :- Suspects = [a,b,c], select( Murderer, Suspects, Witnesses ), phrase( statements(Witnesses), Assertions ), consistent( [guilty(Murderer)|Assertions] ).</pre> A set of assertions is consistent if no inconsistency can be found between any member and the rest of the set. <pre class="prolog">consistent( Statements ) :- \+ inconsistent( Statements ).</pre> An assertion is inconsistent with a set of assertions if it is pairwise exclusive with a member of the set. <pre class="prolog">inconsistent( [Assertion|Assertions] ) :- mutually_exclusive( Exclusive ), select( Assertion, Exclusive, Inconsistent ), member( Inconsistency, Inconsistent ), member( Inconsistency, Assertions ). inconsistent( [_Assertion|Assertions] ) :- inconsistent( Assertions ).</pre> Load a small library of [[Puzzle Utilities]]. <pre class="prolog">:- ensure_loaded( misc ).</pre> The code is available as plain text [https://binding-time.co.uk/download/whodunit.txt here]. ==Result== <pre>?- solve_murder( Murderer ). Murderer = b</pre> 3b150bb75dfd455dd6953caaa2bb58ce21367c4b 0 19 257 242 2022-08-02T19:48:55Z John 2 /* Updating link to HTTPS */ wikitext text/x-wiki __NOTOC__ == Prolog for the Worldwide Web == For a Prolog programmer, to suggest that Prolog is an ideal language for web-based applications is to invite the comment that, &ldquo;if you have only a hammer, everything looks like a nail&rdquo;. However, the correspondences between Prolog behaviour and HTTP, and Prolog data-structures and XML are so strong that it's fair to say that ''if Prolog is a hand, the Worldwide Web is a glove.'' == HTTP == Consider that Prolog's default behaviour is query-solving &ndash; where a query is posed for which arbitrarily many answers (solutions) may be returned. This can be mapped to HTTP's request/response mechanism straightforwardly: === HTTP GET === The HTTP GET verb has a clear correspondence with Prolog's notion of a query. In fact, Prolog can be used directly as part of a request URI, acting as a lightweight data structuring mechanism. However, HTTP requires each request/response to be deterministic, which suggests that ''all'' the solutions for a non-deterministic query should be returned. The solutions can be formatted as an XHTML list or table, for example. === Caching === Prolog programming allows for the 'caching' of expensive results using lemmas, a technique used in the solution of the [[Mister X#Lemmas|Mister X]] puzzle, for example. HTTP's 'HEAD' verb and GET with &ldquo;If-Modified-Since&rdquo; support caching mechanisms, primarily to save communications bandwidth. The integration of Prolog lemmas with HTTP's caching methods can save both bandwidth and recomputation through a single mechanism, enabling the creation of robust distributed applications with a minimum of fuss. === HTTP POST === When using Prolog with HTTP, the POST verb should be reserved for passing clauses from the client to the server, to update the server, not for queries. The fact that Prolog is a good format for including structured (composite) data items as part of a URI can obviate some inappropriate uses of HTTP's POST verb, by allowing more complex terms in GET requests. == XML == HTTP services in which both the client and server are Prolog programs can gain efficiency by exchanging Prolog terms in URIs and results, using Prolog's term I/O facilities. However, XML is becoming established as the preferred format for data exchange in heterogeneous distributed applications. XML data is represented easily in Prolog, and vice versa, because both use tree-structured data exclusively. Because Prolog is a very high-level language, it is more flexible and more powerful than [https://www.w3.org/TR/xslt/all/ XSLT]. In particular, it seems to be very much easier to create robust and reliable transformations with Prolog, i.e. ones that produce only valid output for any valid input. ===xml.pl=== xml.pl is a module for [[parsing XML with Prolog]]. It has been placed in the public domain to encourage the use of Prolog with XML. ==PiLLoW== The [https://cliplab.org/miscdocs/pillow/pillow.html PiLLoW] library provides predicates for developing HTTP client and server applications. For client applications, it provides mechanisms to retrieve HTML files and to parse HTML into useful Prolog terms. For server applications, it provides a predicate to access CGI query parameters so that a Prolog application can be used to handle form input directly i.e. without additional scripting. Additionally, HTML parsing supports the reverse translation of terms into HTML so that forms can be generated. See also, [[Porting PiLLoW to Quintus Prolog]]. 93d09e7c4055fe1502a33b77d6af75f266d91222 0 20 258 205 2022-08-02T19:51:09Z John 2 /* Updating link to HTTPS */ wikitext text/x-wiki == Porting PiLLoW to Quintus Prolog 3.X == The [http://cliplab.org/miscdocs/pillow/pillow.html PiLLoW] library provides predicates for developing HTTP client and server applications. For client applications, it provides mechanisms to retrieve HTML files and to parse HTML into useful Prolog terms. For server applications, it provides a predicate to access CGI query parameters, so that a Prolog application can be used to handle form input directly i.e. without additional scripting. Additionally, HTML parsing supports the reverse translation of terms into HTML, so that forms can be generated. ==PiLLoW 1.1== If you want to port [https://cliplab.org/miscdocs/pillow/pillow.html PiLLoW 1.1] to [https://quintus.sics.se/ Quintus Prolog], the following notes may be of use. ===http_transaction/5=== must be rewritten to use the Quintus tcp and socketio libraries. ====http_transaction(+Host, +Port, +Request, +Timeout, -Response)==== Sends an HTTP <var>Request</var> to an HTTP server <var>Host</var>:<var>Port</var> and returns the resulting message in <var>Response</var>. <var>Timeout</var> defines the maximum number of seconds to wait for a response. <pre class="prolog"> :- use_module(library(tcp)). :- use_module(library(socketio)). :- use_module(library(date), [now/1]). http_transaction( Host, Port, Request, Timeout, Response ) :- tcp:connect( Host, Port, Socket ), Socket >= 0, % Fail if connect error socket_io_open_output( Socket, Ocode ), stream_code( OStream, Ocode ), write_string( OStream, Request ), close( OStream ), socket_io_open_input( Socket, Icode ), stream_code( IStream, Icode ), now( Now ), http_transaction1( Now, Socket, IStream, Timeout, Response ), close( IStream ), tcp:tcp_shutdown( Socket, _Status ), Response \== timeout. http_transaction1( Now, Socket, IStream, Timeout, Response ) :- tcp:tcp_select( 0, Timeout, FD, Status ), http_transaction2( Status, Now, Socket, FD, IStream, Timeout, Response ). http_transaction2( 1, Then, Socket, FD, IStream, Timeout, Response ) :- ( Socket == FD -> stream_to_string( IStream, Response ) ; otherwise -> now( Now ), Elapsed is Now - Then, ( Elapsed < Timeout -> Timeout1 is Timeout - Elapsed, http_transaction1( Now, Socket, IStream, Timeout1, Response ) ; otherwise -> Response = timeout ) ). http_transaction2( 0, _Then, _Socket, _FD, _IStream, _Timeout, timeout ). http_transaction2( -1, _Then, Socket, _FD, IStream, Timeout, _Response ) :- raise_exception( socket_error(Socket, IStream, Timeout) ). getenvstr( Var, Chars ) :- environ( Var, Atom ), atom_chars( Atom, Chars ). :- use_module( library(environ), [environ/2] ). </pre> The ISO Prolog predicates used in PiLLoW can be mapped to equivalent Quintus built-in predicates. <pre class="prolog">flush_output :- ttyflush. atom_codes( Atom, Codes ) :- atom_chars( Atom, Codes ). catch( Goal, Error, Action ) :- on_exception( Error, Goal, Action ). get_code( Code ) :- get0( Code ). get_code( Stream, Code ) :- get0( Stream, Code ). include( File ) :- ensure_loaded( File ). number_codes( Number, Codes ) :- number_chars( Number, Codes ). put_code( Code ) :- put( Code ).</pre> Similarly, some library predicates are not defined/defined differently in Quintus: <pre class="prolog">atom_concat( A, B, AB ) :- name( A, AS ), name( B, BS ), append( AS, BS, ABS ), atom_chars( AB, ABS ). getenv( Var, QueryString ) :- environ( Var, QueryString ). :- use_module( library(environ), [environ/2] ).</pre> ==Pillow 1.0== I have ported PiLLoW 1.0 to use the [https://quintus.sics.se/ Quintus Prolog] 3.X libraries, and made it available as a [https://binding-time.co.uk/download/pillow.zip 260Kb Zip file]. It is offered here as free, '''unsupported''' source code, for which the author accepts no liability whatsoever. '''''Note:''''' The parsing of &quot;multipart&quot; form data on win32 can produce errors, when binary files are submitted, e.g. sending image files as part of the form input. This is because the default for &quot;stdin&quot; on win32 is &quot;text&quot;. 2600a98fc4535e8ec73cd788d69e6929d4a8c5f7 259 258 2022-08-02T19:52:25Z John 2 /* Updating link to HTTPS */ wikitext text/x-wiki == Porting PiLLoW to Quintus Prolog 3.X == The [https://cliplab.org/miscdocs/pillow/pillow.html PiLLoW] library provides predicates for developing HTTP client and server applications. For client applications, it provides mechanisms to retrieve HTML files and to parse HTML into useful Prolog terms. For server applications, it provides a predicate to access CGI query parameters, so that a Prolog application can be used to handle form input directly i.e. without additional scripting. Additionally, HTML parsing supports the reverse translation of terms into HTML, so that forms can be generated. ==PiLLoW 1.1== If you want to port [https://cliplab.org/miscdocs/pillow/pillow.html PiLLoW 1.1] to [https://quintus.sics.se/ Quintus Prolog], the following notes may be of use. ===http_transaction/5=== must be rewritten to use the Quintus tcp and socketio libraries. ====http_transaction(+Host, +Port, +Request, +Timeout, -Response)==== Sends an HTTP <var>Request</var> to an HTTP server <var>Host</var>:<var>Port</var> and returns the resulting message in <var>Response</var>. <var>Timeout</var> defines the maximum number of seconds to wait for a response. <pre class="prolog"> :- use_module(library(tcp)). :- use_module(library(socketio)). :- use_module(library(date), [now/1]). http_transaction( Host, Port, Request, Timeout, Response ) :- tcp:connect( Host, Port, Socket ), Socket >= 0, % Fail if connect error socket_io_open_output( Socket, Ocode ), stream_code( OStream, Ocode ), write_string( OStream, Request ), close( OStream ), socket_io_open_input( Socket, Icode ), stream_code( IStream, Icode ), now( Now ), http_transaction1( Now, Socket, IStream, Timeout, Response ), close( IStream ), tcp:tcp_shutdown( Socket, _Status ), Response \== timeout. http_transaction1( Now, Socket, IStream, Timeout, Response ) :- tcp:tcp_select( 0, Timeout, FD, Status ), http_transaction2( Status, Now, Socket, FD, IStream, Timeout, Response ). http_transaction2( 1, Then, Socket, FD, IStream, Timeout, Response ) :- ( Socket == FD -> stream_to_string( IStream, Response ) ; otherwise -> now( Now ), Elapsed is Now - Then, ( Elapsed < Timeout -> Timeout1 is Timeout - Elapsed, http_transaction1( Now, Socket, IStream, Timeout1, Response ) ; otherwise -> Response = timeout ) ). http_transaction2( 0, _Then, _Socket, _FD, _IStream, _Timeout, timeout ). http_transaction2( -1, _Then, Socket, _FD, IStream, Timeout, _Response ) :- raise_exception( socket_error(Socket, IStream, Timeout) ). getenvstr( Var, Chars ) :- environ( Var, Atom ), atom_chars( Atom, Chars ). :- use_module( library(environ), [environ/2] ). </pre> The ISO Prolog predicates used in PiLLoW can be mapped to equivalent Quintus built-in predicates. <pre class="prolog">flush_output :- ttyflush. atom_codes( Atom, Codes ) :- atom_chars( Atom, Codes ). catch( Goal, Error, Action ) :- on_exception( Error, Goal, Action ). get_code( Code ) :- get0( Code ). get_code( Stream, Code ) :- get0( Stream, Code ). include( File ) :- ensure_loaded( File ). number_codes( Number, Codes ) :- number_chars( Number, Codes ). put_code( Code ) :- put( Code ).</pre> Similarly, some library predicates are not defined/defined differently in Quintus: <pre class="prolog">atom_concat( A, B, AB ) :- name( A, AS ), name( B, BS ), append( AS, BS, ABS ), atom_chars( AB, ABS ). getenv( Var, QueryString ) :- environ( Var, QueryString ). :- use_module( library(environ), [environ/2] ).</pre> ==Pillow 1.0== I have ported PiLLoW 1.0 to use the [https://quintus.sics.se/ Quintus Prolog] 3.X libraries, and made it available as a [https://binding-time.co.uk/download/pillow.zip 260Kb Zip file]. It is offered here as free, '''unsupported''' source code, for which the author accepts no liability whatsoever. '''''Note:''''' The parsing of &quot;multipart&quot; form data on win32 can produce errors, when binary files are submitted, e.g. sending image files as part of the form input. This is because the default for &quot;stdin&quot; on win32 is &quot;text&quot;. c3a860cb79edd895ffdf31b73d0b1d84e402bc7c 0 22 260 249 2022-08-02T20:00:21Z John 2 /* Updating link to HTTPS */ wikitext text/x-wiki __NOTOC__ Out of the many Prolog programming books that I have read, I consider these to be the best. == Starting Out == Prolog is a deep subject, rather than a broad one, so it is best studied in stages. Clocksin &amp; Mellish's [https://www.worldcat.org/title/programming-in-prolog/oclc/1199008151/editions Programming in Prolog] is the definitive introductory text on Prolog. Most importantly, it will help you to start programming straight away. == More Advanced Applications == I regard Peter Flach's [https://www.worldcat.org/title/simply-logical-intelligent-reasoning-by-example/oclc/246150014/editions Simply Logical: Intelligent Reasoning by Example] as the best advanced text. It deals with both theoretical and practical aspects of logic programming but doesn't assume prior knowledge beyond that you will have gained from &quot;Programming in Prolog&quot;. It has an interactive edition at [https://book.simply-logical.space/ simply-logical.space] or you can download the programs in the book, and the book as a <abbr title="Portable Document Format">PDF</abbr> file, from [https://github.com/simply-logical/ Simply Logical on GitHub]. == The Last Word == Robert Kowalski's classic [https://www.worldcat.org/title/logic-for-problem-solving/oclc/710744783/editions Logic for Problem Solving] is essential reading for Prolog programmers. [https://www.worldcat.org/title/logic-for-problem-solving-revisited/oclc/958465391/editions Logic for Problem Solving, Revisited] is a more recent, revised edition. The original book has been scanned into PDF format and can be downloaded from [https://www.doc.ic.ac.uk/~rak/ Robert Kowalski's homepage]. == Getting Technical == Performance and memory utilization become important when Prolog is used to solve complex problems. David Harel's [https://www.worldcat.org/title/algorithmics-the-spirit-of-computing/oclc/889969825/editions Algorithmics] is a very accessible treatment of program behaviour. It isn't tied to one programming language and the techniques described are readily applicable to Prolog programs. Richard O'Keefe's [https://www.worldcat.org/title/craft-of-prolog/oclc/1024831685/editions The Craft of Prolog] is a superb exposition of the techniques that can be employed to work ''with'' Prolog, rather than fighting against it, and the rationale behind them. e1cbca120897be4414d494a9fdfeb3c220668f06 263 260 2022-08-24T21:11:55Z John 2 Changes to worldcat.org URL format. wikitext text/x-wiki __NOTOC__ Out of the many Prolog programming books that I have read, I consider these to be the best. == Starting Out == Prolog is a deep subject, rather than a broad one, so it is best studied in stages. Clocksin &amp; Mellish's [https://www.worldcat.org/formats-editions/1199008151 Programming in Prolog] is the definitive introductory text on Prolog. Most importantly, it will help you to start programming straight away. == More Advanced Applications == I regard Peter Flach's [https://www.worldcat.org/formats-editions/246150014 Simply Logical: Intelligent Reasoning by Example] as the best advanced text. It deals with both theoretical and practical aspects of logic programming but doesn't assume prior knowledge beyond that you will have gained from &quot;Programming in Prolog&quot;. It has an interactive edition at [https://book.simply-logical.space/ simply-logical.space] or you can download the programs in the book, and the book as a <abbr title="Portable Document Format">PDF</abbr> file, from [https://github.com/simply-logical/ Simply Logical on GitHub]. == The Last Word == Robert Kowalski's classic [https://www.worldcat.org/formats-editions/710744783 Logic for Problem Solving] is essential reading for Prolog programmers. [https://www.worldcat.org/formats-editions/958465391 Logic for Problem Solving, Revisited] is a more recent, revised edition. The original book has been scanned into PDF format and can be downloaded from [https://www.doc.ic.ac.uk/~rak/ Robert Kowalski's homepage]. == Getting Technical == Performance and memory utilization become important when Prolog is used to solve complex problems. David Harel's [https://www.worldcat.org/formats-editions/889969825 Algorithmics] is a very accessible treatment of program behaviour. It isn't tied to one programming language and the techniques described are readily applicable to Prolog programs. Richard O'Keefe's [https://www.worldcat.org/formats-editions/1024831685 The Craft of Prolog] is a superb exposition of the techniques that can be employed to work ''with'' Prolog, rather than fighting against it, and the rationale behind them. f52387dd1693f7e2ed2287f6fde21bed2c604973 298 263 2024-11-23T21:48:11Z John 2 Update to Worldcat URL sub-domain. wikitext text/x-wiki __NOTOC__ Out of the many Prolog programming books that I have read, I consider these to be the best. == Starting Out == Prolog is a deep subject, rather than a broad one, so it is best studied in stages. Clocksin &amp; Mellish's [https://search.worldcat.org/formats-editions/1199008151 Programming in Prolog] is the definitive introductory text on Prolog. Most importantly, it will help you to start programming straight away. == More Advanced Applications == I regard Peter Flach's [https://search.worldcat.org/formats-editions/246150014 Simply Logical: Intelligent Reasoning by Example] as the best advanced text. It deals with both theoretical and practical aspects of logic programming but doesn't assume prior knowledge beyond that you will have gained from &quot;Programming in Prolog&quot;. It has an interactive edition at [https://book.simply-logical.space/ simply-logical.space] or you can download the programs in the book, and the book as a <abbr title="Portable Document Format">PDF</abbr> file, from [https://github.com/simply-logical/ Simply Logical on GitHub]. == The Last Word == Robert Kowalski's classic [https://search.worldcat.org/formats-editions/710744783 Logic for Problem Solving] is essential reading for Prolog programmers. [https://search.worldcat.org/formats-editions/958465391 Logic for Problem Solving, Revisited] is a more recent, revised edition. The original book has been scanned into PDF format and can be downloaded from [https://www.doc.ic.ac.uk/~rak/ Robert Kowalski's homepage]. == Getting Technical == Performance and memory utilization become important when Prolog is used to solve complex problems. David Harel's [https://search.worldcat.org/formats-editions/889969825 Algorithmics] is a very accessible treatment of program behaviour. It isn't tied to one programming language and the techniques described are readily applicable to Prolog programs. Richard O'Keefe's [https://search.worldcat.org/formats-editions/1024831685 The Craft of Prolog] is a superb exposition of the techniques that can be employed to work ''with'' Prolog, rather than fighting against it, and the rationale behind them. 52e24b1da5111b117e9fe94456fb8026b245c917 0 8 261 247 2022-08-02T20:03:40Z John 2 /* Updating link to HTTPS */ wikitext text/x-wiki __NOTOC__ This classic AI problem is described in ''Artificial Intelligence'' as follows: <blockquote> &ldquo;You are given two jugs, a 4-gallon one and a 3-gallon one. Neither has any measuring markers on it. There is a tap that can be used to fill the jugs with water. How can you get exactly 2 gallons of water into the 4-gallon jug?&rdquo;. <cite>[https://www.worldcat.org/title/artificial-intelligence/oclc/473650331/editions E. Rich & K. Knight, Artificial Intelligence, 2nd edition, McGraw-Hill, 1991]</cite> </blockquote> This program implements an environmentally responsible solution to the ''water jugs'' problem. Rather than filling and spilling from an infinite water resource, we conserve a finite initial charge with a third jug: (reservoir). This approach is simpler than the traditional method because there are only two actions. It is more flexible than the traditional method because it can solve problems that are constrained by a limited supply from the reservoir<ref>For example, the "[https://www.cut-the-knot.org/water.shtml Three Glass Puzzle]" where the jugs have capacities of 8 (filled), 5 and 3 and the goal is to get two equal volumes (4).</ref>. To simulate the infinite version, we use a filled reservoir with a capacity greater than the combined capacities of the jugs so that the reservoir can never be emptied. <blockquote> &ldquo;Perfection is achieved not when there is nothing more to add, but when there is nothing more to take away.&rdquo; <cite>[https://en.wikiquote.org/wiki/Antoine_de_Saint_Exup%C3%A9ry Antoine de Saint-Exup&#233;ry]</cite> </blockquote> ==Solution== ====water_jugs==== is the entry point. The solution is derived by a simple, breadth-first, state-space search, and translated into a readable format by a DCG. <pre class="prolog">water_jugs :- SmallCapacity = 3, LargeCapacity = 4, Reservoir is SmallCapacity + LargeCapacity + 1, volume( small, Capacities, SmallCapacity ), volume( large, Capacities, LargeCapacity ), volume( reservoir, Capacities, Reservoir ), volume( small, Start, 0 ), volume( large, Start, 0 ), volume( reservoir, Start, Reservoir ), volume( large, End, 2 ), water_jugs_solution( Start, Capacities, End, Solution ), phrase( narrative(Solution, Capacities, End), Chars ), put_chars( Chars ).</pre> ====water_jugs_solution( +Start, +Capacities, +End, ?Solution )==== holds when <var>Solution</var> is the terminal state in a state-space search that begins with an initial state, in which the water-jugs have <var>Capacities</var> and contain the <var>Start</var> volumes, and ends when the water-jugs contain the <var>End</var> volumes. <pre class="prolog"> water_jugs_solution( Start, Capacities, End, Solution ) :- solve_jugs( [start(Start)], Capacities, [], End, Solution ). </pre> ====solve_jugs( +Nodes, +Capacities, +Visited, +End, ?Solution )==== holds when <var>Solution</var> is the terminal node in a state-space search, beginning with a first open node in <var>Nodes</var>, and terminating when the water-jugs contain the <var>End</var> volumes. <var>Capacities</var> define the capacities of the water-jugs while <var>Visited</var> is a list of expanded (closed) node states. The breadth-first operation of solve_jugs is due to the existing <var>Nodes</var> being appended to the new nodes. (If the new nodes were appended to the existing nodes, the operation would be depth-first.) <pre class="prolog"> solve_jugs( [Node|Nodes], Capacities, Visited, End, Solution ) :- node_state( Node, State ), ( State = End -> Solution = Node ; otherwise -> findall( Successor, successor(Node, Capacities, Visited, Successor), Successors ), append( Nodes, Successors, NewNodes ), solve_jugs( NewNodes, Capacities, [State|Visited], End, Solution ) ). </pre> ====successor( +Node, +Capacities, +Visited, ?Successor )==== <var>Successor</var> is a successor of <var>Node</var>, for water-jugs with <var>Capacities</var>, if there is a legal transition from <var>Node</var>'s state to <var>Successor</var>'s state and <var>Successor</var>'s state is not a member of the <var>Visited</var> states. <pre class="prolog"> successor( Node, Capacities, Visited, Successor ) :- node_state( Node, State ), Successor = node(Action,State1,Node), jug_transition( State, Capacities, Action, State1 ), \+ member( State1, Visited ). </pre> ===Transition Rules=== ====jug_transition( +State, +Capacities, ?Action, ?SuccessorState )==== holds when <var>Action</var> describes a valid transition, from <var>State</var> to <var>SuccessorState</var>, for water-jugs with <var>Capacities</var>. There are two sorts of <var>Action</var>: * <code>empty_into(Source,Target)</code> valid if ''Source'' is not already empty and the combined contents from ''Source'' and ''Target'', in <var>State</var>, are not greater than the capacity of the ''Target'' jug. The ''Source'' jug becomes empty in <var>SuccessorState</var> while the ''Target'' jug acquires the combined contents of ''Source'' and ''Target'' in <var>State</var>. * <code>fill_from(Source,Target)</code> valid if ''Source'' is not already empty, and the combined contents from ''Source'' and ''Target'', in <var>State</var>, are greater than the capacity of the ''Target'' jug. The ''Target'' jug becomes full in <var>SuccessorState</var>, while ''Source'' retains the excess of the combined contents of ''Source'' and ''Target'' in <var>State</var>, over the capacity of the ''Target'' jug. In either case, the contents of the unused jug are unchanged. <pre class="prolog">jug_transition( State0, Capacities, Action, State1 ) :- volume( Source, State0, SourceContents ), SourceContents > 0, jug_permutation( Source, Target, Unused ), volume( Target, State0, TargetContents ), volume( Target, Capacities, TargetCapacity ), volume( Unused, State0, Unchanged ), volume( Unused, State1, Unchanged ), CombinedContents is SourceContents + TargetContents, ( CombinedContents =< TargetCapacity -> Action = empty_into(Source,Target), NewSourceContents = 0, NewTargetContents = CombinedContents ; CombinedContents > TargetCapacity -> Action = fill_from(Source,Target), NewSourceContents is CombinedContents-TargetCapacity, NewTargetContents = TargetCapacity ), volume( Source, State1, NewSourceContents ), volume( Target, State1, NewTargetContents ).</pre> ==Data Abstraction== ====volume( ?Jug, ?State, ?Volume )==== holds when <var>Jug</var> (large, small or reservoir) has <var>Volume</var> in <var>State</var>. <pre class="prolog"> volume( small, jugs(Small, _Large, _Reservoir), Small ). volume( large, jugs(_Small, Large, _Reservoir), Large ). volume( reservoir, jugs(_Small, _Large, Reservoir), Reservoir ). </pre> ====jug_permutation( ?Source, ?Target, ?Unused )==== holds when <var>Source</var>, <var>Target</var> and <var>Unused</var> are a permutation of <code>small</code>, <code>large</code> and <code>reservoir</code>. <pre class="prolog"> jug_permutation( Source, Target, Unused ) :- select( Source, [small, large, reservoir], Residue ), select( Target, Residue, [Unused] ). </pre> ====node_state( ?Node, ?State )==== holds when the contents of the water-jugs at <var>Node</var> are described by <var>State</var>. <pre class="prolog"> node_state( start(State), State ). node_state( node(_Transition, State, _Predecessor), State ). </pre> ==Definite Clause Grammar== ====narrative( +Solution, +Capacities, +End )/==== is a DCG presenting the water-jugs <var>Solution</var> in a readable format. The grammar is head-recursive because the <var>Solution</var> has the last node outermost. <pre class="prolog"> narrative( start(Start), Capacities, End ) --> "Given three jugs with capacities of:", newline, literal_volumes( Capacities ), "To obtain the result:", newline, literal_volumes( End ), "Starting with:", newline, literal_volumes( Start ), "Do the following:", newline. narrative( node(Transition, Result, Predecessor), Capacities, End ) --> narrative( Predecessor, Capacities, End ), literal_action( Transition, Result ). literal_volumes( Volumes ) --> indent, literal( Volumes ), ";", newline. literal_action( Transition, Result ) --> indent, "- ", literal( Transition ), " giving:", newline, indent, indent, literal( Result ), newline. literal( empty_into(From,To) ) --> "Empty the ", literal( From ), " into the ", literal( To ). literal( fill_from(From,To) ) --> "Fill the ", literal( To ), " from the ", literal( From ). literal( jugs(Small,Large,Reservoir) ) --> literal_number( Small ), " gallons in the small jug, ", literal_number( Large ), " gallons in the large jug and ", literal_number( Reservoir ), " gallons in the reservoir". literal( small ) --> "small jug". literal( large ) --> "large jug". literal( reservoir ) --> "reservoir". literal_number( Number, Plus, Minus ) :- number( Number ), name( Number, Chars ), append( Chars, Minus, Plus ). indent --> " ". newline --> " ". </pre> ==Utility Predicates== Load a small library of [[Puzzle Utilities]]. <pre class="prolog"> :- ensure_loaded( misc ). </pre> The code is available as plain text [https://binding-time.co.uk/download/water_jugs.txt here]. ==Output== The output of the program is: <div class="result"> <pre> ?- water_jugs. Given three jugs with capacities of: 3 gallons in the small jug, 4 gallons in the large jug and 8 gallons in the reservoir; To obtain the result: 0 gallons in the small jug, 2 gallons in the large jug and 6 gallons in the reservoir; Starting with: 0 gallons in the small jug, 0 gallons in the large jug and 8 gallons in the reservoir; Do the following: - Fill the small jug from the reservoir giving: 3 gallons in the small jug, 0 gallons in the large jug and 5 gallons in the reservoir - Empty the small jug into the large jug giving: 0 gallons in the small jug, 3 gallons in the large jug and 5 gallons in the reservoir - Fill the small jug from the reservoir giving: 3 gallons in the small jug, 3 gallons in the large jug and 2 gallons in the reservoir - Fill the large jug from the small jug giving: 2 gallons in the small jug, 4 gallons in the large jug and 2 gallons in the reservoir - Empty the large jug into the reservoir giving: 2 gallons in the small jug, 0 gallons in the large jug and 6 gallons in the reservoir - Empty the small jug into the large jug giving: 0 gallons in the small jug, 2 gallons in the large jug and 6 gallons in the reservoir yes </pre> </div> =====Footnote===== <references/> 185f8e0c598590caba9534633d9deefbe74bb679 264 261 2022-08-24T21:19:08Z John 2 Change to worldcat.org URL format. wikitext text/x-wiki __NOTOC__ This classic AI problem is described in ''Artificial Intelligence'' as follows: <blockquote> &ldquo;You are given two jugs, a 4-gallon one and a 3-gallon one. Neither has any measuring markers on it. There is a tap that can be used to fill the jugs with water. How can you get exactly 2 gallons of water into the 4-gallon jug?&rdquo;. <cite>[https://www.worldcat.org/formats-editions/473650331 E. Rich & K. Knight, Artificial Intelligence, 2nd edition, McGraw-Hill, 1991]</cite> </blockquote> This program implements an environmentally responsible solution to the ''water jugs'' problem. Rather than filling and spilling from an infinite water resource, we conserve a finite initial charge with a third jug: (reservoir). This approach is simpler than the traditional method because there are only two actions. It is more flexible than the traditional method because it can solve problems that are constrained by a limited supply from the reservoir<ref>For example, the "[https://www.cut-the-knot.org/water.shtml Three Glass Puzzle]" where the jugs have capacities of 8 (filled), 5 and 3 and the goal is to get two equal volumes (4).</ref>. To simulate the infinite version, we use a filled reservoir with a capacity greater than the combined capacities of the jugs so that the reservoir can never be emptied. <blockquote> &ldquo;Perfection is achieved not when there is nothing more to add, but when there is nothing more to take away.&rdquo; <cite>[https://en.wikiquote.org/wiki/Antoine_de_Saint_Exup%C3%A9ry Antoine de Saint-Exup&#233;ry]</cite> </blockquote> ==Solution== ====water_jugs==== is the entry point. The solution is derived by a simple, breadth-first, state-space search, and translated into a readable format by a DCG. <pre class="prolog">water_jugs :- SmallCapacity = 3, LargeCapacity = 4, Reservoir is SmallCapacity + LargeCapacity + 1, volume( small, Capacities, SmallCapacity ), volume( large, Capacities, LargeCapacity ), volume( reservoir, Capacities, Reservoir ), volume( small, Start, 0 ), volume( large, Start, 0 ), volume( reservoir, Start, Reservoir ), volume( large, End, 2 ), water_jugs_solution( Start, Capacities, End, Solution ), phrase( narrative(Solution, Capacities, End), Chars ), put_chars( Chars ).</pre> ====water_jugs_solution( +Start, +Capacities, +End, ?Solution )==== holds when <var>Solution</var> is the terminal state in a state-space search that begins with an initial state, in which the water-jugs have <var>Capacities</var> and contain the <var>Start</var> volumes, and ends when the water-jugs contain the <var>End</var> volumes. <pre class="prolog"> water_jugs_solution( Start, Capacities, End, Solution ) :- solve_jugs( [start(Start)], Capacities, [], End, Solution ). </pre> ====solve_jugs( +Nodes, +Capacities, +Visited, +End, ?Solution )==== holds when <var>Solution</var> is the terminal node in a state-space search, beginning with a first open node in <var>Nodes</var>, and terminating when the water-jugs contain the <var>End</var> volumes. <var>Capacities</var> define the capacities of the water-jugs while <var>Visited</var> is a list of expanded (closed) node states. The breadth-first operation of solve_jugs is due to the existing <var>Nodes</var> being appended to the new nodes. (If the new nodes were appended to the existing nodes, the operation would be depth-first.) <pre class="prolog"> solve_jugs( [Node|Nodes], Capacities, Visited, End, Solution ) :- node_state( Node, State ), ( State = End -> Solution = Node ; otherwise -> findall( Successor, successor(Node, Capacities, Visited, Successor), Successors ), append( Nodes, Successors, NewNodes ), solve_jugs( NewNodes, Capacities, [State|Visited], End, Solution ) ). </pre> ====successor( +Node, +Capacities, +Visited, ?Successor )==== <var>Successor</var> is a successor of <var>Node</var>, for water-jugs with <var>Capacities</var>, if there is a legal transition from <var>Node</var>'s state to <var>Successor</var>'s state and <var>Successor</var>'s state is not a member of the <var>Visited</var> states. <pre class="prolog"> successor( Node, Capacities, Visited, Successor ) :- node_state( Node, State ), Successor = node(Action,State1,Node), jug_transition( State, Capacities, Action, State1 ), \+ member( State1, Visited ). </pre> ===Transition Rules=== ====jug_transition( +State, +Capacities, ?Action, ?SuccessorState )==== holds when <var>Action</var> describes a valid transition, from <var>State</var> to <var>SuccessorState</var>, for water-jugs with <var>Capacities</var>. There are two sorts of <var>Action</var>: * <code>empty_into(Source,Target)</code> valid if ''Source'' is not already empty and the combined contents from ''Source'' and ''Target'', in <var>State</var>, are not greater than the capacity of the ''Target'' jug. The ''Source'' jug becomes empty in <var>SuccessorState</var> while the ''Target'' jug acquires the combined contents of ''Source'' and ''Target'' in <var>State</var>. * <code>fill_from(Source,Target)</code> valid if ''Source'' is not already empty, and the combined contents from ''Source'' and ''Target'', in <var>State</var>, are greater than the capacity of the ''Target'' jug. The ''Target'' jug becomes full in <var>SuccessorState</var>, while ''Source'' retains the excess of the combined contents of ''Source'' and ''Target'' in <var>State</var>, over the capacity of the ''Target'' jug. In either case, the contents of the unused jug are unchanged. <pre class="prolog">jug_transition( State0, Capacities, Action, State1 ) :- volume( Source, State0, SourceContents ), SourceContents > 0, jug_permutation( Source, Target, Unused ), volume( Target, State0, TargetContents ), volume( Target, Capacities, TargetCapacity ), volume( Unused, State0, Unchanged ), volume( Unused, State1, Unchanged ), CombinedContents is SourceContents + TargetContents, ( CombinedContents =< TargetCapacity -> Action = empty_into(Source,Target), NewSourceContents = 0, NewTargetContents = CombinedContents ; CombinedContents > TargetCapacity -> Action = fill_from(Source,Target), NewSourceContents is CombinedContents-TargetCapacity, NewTargetContents = TargetCapacity ), volume( Source, State1, NewSourceContents ), volume( Target, State1, NewTargetContents ).</pre> ==Data Abstraction== ====volume( ?Jug, ?State, ?Volume )==== holds when <var>Jug</var> (large, small or reservoir) has <var>Volume</var> in <var>State</var>. <pre class="prolog"> volume( small, jugs(Small, _Large, _Reservoir), Small ). volume( large, jugs(_Small, Large, _Reservoir), Large ). volume( reservoir, jugs(_Small, _Large, Reservoir), Reservoir ). </pre> ====jug_permutation( ?Source, ?Target, ?Unused )==== holds when <var>Source</var>, <var>Target</var> and <var>Unused</var> are a permutation of <code>small</code>, <code>large</code> and <code>reservoir</code>. <pre class="prolog"> jug_permutation( Source, Target, Unused ) :- select( Source, [small, large, reservoir], Residue ), select( Target, Residue, [Unused] ). </pre> ====node_state( ?Node, ?State )==== holds when the contents of the water-jugs at <var>Node</var> are described by <var>State</var>. <pre class="prolog"> node_state( start(State), State ). node_state( node(_Transition, State, _Predecessor), State ). </pre> ==Definite Clause Grammar== ====narrative( +Solution, +Capacities, +End )/==== is a DCG presenting the water-jugs <var>Solution</var> in a readable format. The grammar is head-recursive because the <var>Solution</var> has the last node outermost. <pre class="prolog"> narrative( start(Start), Capacities, End ) --> "Given three jugs with capacities of:", newline, literal_volumes( Capacities ), "To obtain the result:", newline, literal_volumes( End ), "Starting with:", newline, literal_volumes( Start ), "Do the following:", newline. narrative( node(Transition, Result, Predecessor), Capacities, End ) --> narrative( Predecessor, Capacities, End ), literal_action( Transition, Result ). literal_volumes( Volumes ) --> indent, literal( Volumes ), ";", newline. literal_action( Transition, Result ) --> indent, "- ", literal( Transition ), " giving:", newline, indent, indent, literal( Result ), newline. literal( empty_into(From,To) ) --> "Empty the ", literal( From ), " into the ", literal( To ). literal( fill_from(From,To) ) --> "Fill the ", literal( To ), " from the ", literal( From ). literal( jugs(Small,Large,Reservoir) ) --> literal_number( Small ), " gallons in the small jug, ", literal_number( Large ), " gallons in the large jug and ", literal_number( Reservoir ), " gallons in the reservoir". literal( small ) --> "small jug". literal( large ) --> "large jug". literal( reservoir ) --> "reservoir". literal_number( Number, Plus, Minus ) :- number( Number ), name( Number, Chars ), append( Chars, Minus, Plus ). indent --> " ". newline --> " ". </pre> ==Utility Predicates== Load a small library of [[Puzzle Utilities]]. <pre class="prolog"> :- ensure_loaded( misc ). </pre> The code is available as plain text [https://binding-time.co.uk/download/water_jugs.txt here]. ==Output== The output of the program is: <div class="result"> <pre> ?- water_jugs. Given three jugs with capacities of: 3 gallons in the small jug, 4 gallons in the large jug and 8 gallons in the reservoir; To obtain the result: 0 gallons in the small jug, 2 gallons in the large jug and 6 gallons in the reservoir; Starting with: 0 gallons in the small jug, 0 gallons in the large jug and 8 gallons in the reservoir; Do the following: - Fill the small jug from the reservoir giving: 3 gallons in the small jug, 0 gallons in the large jug and 5 gallons in the reservoir - Empty the small jug into the large jug giving: 0 gallons in the small jug, 3 gallons in the large jug and 5 gallons in the reservoir - Fill the small jug from the reservoir giving: 3 gallons in the small jug, 3 gallons in the large jug and 2 gallons in the reservoir - Fill the large jug from the small jug giving: 2 gallons in the small jug, 4 gallons in the large jug and 2 gallons in the reservoir - Empty the large jug into the reservoir giving: 2 gallons in the small jug, 0 gallons in the large jug and 6 gallons in the reservoir - Empty the small jug into the large jug giving: 0 gallons in the small jug, 2 gallons in the large jug and 6 gallons in the reservoir yes </pre> </div> =====Footnote===== <references/> 7e7e6fdfef1b0eb249e872836aa4889d78fa97b7 297 264 2024-11-23T21:38:54Z John 2 wikitext text/x-wiki __NOTOC__ This classic AI problem is described in ''Artificial Intelligence'' as follows: <blockquote> &ldquo;You are given two jugs, a 4-gallon one and a 3-gallon one. Neither has any measuring markers on it. There is a tap that can be used to fill the jugs with water. How can you get exactly 2 gallons of water into the 4-gallon jug?&rdquo;. <cite>[https://search.worldcat.org/formats-editions/473650331 E. Rich & K. Knight, Artificial Intelligence, 2nd edition, McGraw-Hill, 1991]</cite> </blockquote> This program implements an environmentally responsible solution to the ''water jugs'' problem. Rather than filling and spilling from an infinite water resource, we conserve a finite initial charge with a third jug: (reservoir). This approach is simpler than the traditional method because there are only two actions. It is more flexible than the traditional method because it can solve problems that are constrained by a limited supply from the reservoir<ref>For example, the "[https://www.cut-the-knot.org/water.shtml Three Glass Puzzle]" where the jugs have capacities of 8 (filled), 5 and 3 and the goal is to get two equal volumes (4).</ref>. To simulate the infinite version, we use a filled reservoir with a capacity greater than the combined capacities of the jugs so that the reservoir can never be emptied. <blockquote> &ldquo;Perfection is achieved not when there is nothing more to add, but when there is nothing more to take away.&rdquo; <cite>[https://en.wikiquote.org/wiki/Antoine_de_Saint_Exup%C3%A9ry Antoine de Saint-Exup&#233;ry]</cite> </blockquote> ==Solution== ====water_jugs==== is the entry point. The solution is derived by a simple, breadth-first, state-space search, and translated into a readable format by a DCG. <pre class="prolog">water_jugs :- SmallCapacity = 3, LargeCapacity = 4, Reservoir is SmallCapacity + LargeCapacity + 1, volume( small, Capacities, SmallCapacity ), volume( large, Capacities, LargeCapacity ), volume( reservoir, Capacities, Reservoir ), volume( small, Start, 0 ), volume( large, Start, 0 ), volume( reservoir, Start, Reservoir ), volume( large, End, 2 ), water_jugs_solution( Start, Capacities, End, Solution ), phrase( narrative(Solution, Capacities, End), Chars ), put_chars( Chars ).</pre> ====water_jugs_solution( +Start, +Capacities, +End, ?Solution )==== holds when <var>Solution</var> is the terminal state in a state-space search that begins with an initial state, in which the water-jugs have <var>Capacities</var> and contain the <var>Start</var> volumes, and ends when the water-jugs contain the <var>End</var> volumes. <pre class="prolog"> water_jugs_solution( Start, Capacities, End, Solution ) :- solve_jugs( [start(Start)], Capacities, [], End, Solution ). </pre> ====solve_jugs( +Nodes, +Capacities, +Visited, +End, ?Solution )==== holds when <var>Solution</var> is the terminal node in a state-space search, beginning with a first open node in <var>Nodes</var>, and terminating when the water-jugs contain the <var>End</var> volumes. <var>Capacities</var> define the capacities of the water-jugs while <var>Visited</var> is a list of expanded (closed) node states. The breadth-first operation of solve_jugs is due to the existing <var>Nodes</var> being appended to the new nodes. (If the new nodes were appended to the existing nodes, the operation would be depth-first.) <pre class="prolog"> solve_jugs( [Node|Nodes], Capacities, Visited, End, Solution ) :- node_state( Node, State ), ( State = End -> Solution = Node ; otherwise -> findall( Successor, successor(Node, Capacities, Visited, Successor), Successors ), append( Nodes, Successors, NewNodes ), solve_jugs( NewNodes, Capacities, [State|Visited], End, Solution ) ). </pre> ====successor( +Node, +Capacities, +Visited, ?Successor )==== <var>Successor</var> is a successor of <var>Node</var>, for water-jugs with <var>Capacities</var>, if there is a legal transition from <var>Node</var>'s state to <var>Successor</var>'s state and <var>Successor</var>'s state is not a member of the <var>Visited</var> states. <pre class="prolog"> successor( Node, Capacities, Visited, Successor ) :- node_state( Node, State ), Successor = node(Action,State1,Node), jug_transition( State, Capacities, Action, State1 ), \+ member( State1, Visited ). </pre> ===Transition Rules=== ====jug_transition( +State, +Capacities, ?Action, ?SuccessorState )==== holds when <var>Action</var> describes a valid transition, from <var>State</var> to <var>SuccessorState</var>, for water-jugs with <var>Capacities</var>. There are two sorts of <var>Action</var>: * <code>empty_into(Source,Target)</code> valid if ''Source'' is not already empty and the combined contents from ''Source'' and ''Target'', in <var>State</var>, are not greater than the capacity of the ''Target'' jug. The ''Source'' jug becomes empty in <var>SuccessorState</var> while the ''Target'' jug acquires the combined contents of ''Source'' and ''Target'' in <var>State</var>. * <code>fill_from(Source,Target)</code> valid if ''Source'' is not already empty, and the combined contents from ''Source'' and ''Target'', in <var>State</var>, are greater than the capacity of the ''Target'' jug. The ''Target'' jug becomes full in <var>SuccessorState</var>, while ''Source'' retains the excess of the combined contents of ''Source'' and ''Target'' in <var>State</var>, over the capacity of the ''Target'' jug. In either case, the contents of the unused jug are unchanged. <pre class="prolog">jug_transition( State0, Capacities, Action, State1 ) :- volume( Source, State0, SourceContents ), SourceContents > 0, jug_permutation( Source, Target, Unused ), volume( Target, State0, TargetContents ), volume( Target, Capacities, TargetCapacity ), volume( Unused, State0, Unchanged ), volume( Unused, State1, Unchanged ), CombinedContents is SourceContents + TargetContents, ( CombinedContents =< TargetCapacity -> Action = empty_into(Source,Target), NewSourceContents = 0, NewTargetContents = CombinedContents ; CombinedContents > TargetCapacity -> Action = fill_from(Source,Target), NewSourceContents is CombinedContents-TargetCapacity, NewTargetContents = TargetCapacity ), volume( Source, State1, NewSourceContents ), volume( Target, State1, NewTargetContents ).</pre> ==Data Abstraction== ====volume( ?Jug, ?State, ?Volume )==== holds when <var>Jug</var> (large, small or reservoir) has <var>Volume</var> in <var>State</var>. <pre class="prolog"> volume( small, jugs(Small, _Large, _Reservoir), Small ). volume( large, jugs(_Small, Large, _Reservoir), Large ). volume( reservoir, jugs(_Small, _Large, Reservoir), Reservoir ). </pre> ====jug_permutation( ?Source, ?Target, ?Unused )==== holds when <var>Source</var>, <var>Target</var> and <var>Unused</var> are a permutation of <code>small</code>, <code>large</code> and <code>reservoir</code>. <pre class="prolog"> jug_permutation( Source, Target, Unused ) :- select( Source, [small, large, reservoir], Residue ), select( Target, Residue, [Unused] ). </pre> ====node_state( ?Node, ?State )==== holds when the contents of the water-jugs at <var>Node</var> are described by <var>State</var>. <pre class="prolog"> node_state( start(State), State ). node_state( node(_Transition, State, _Predecessor), State ). </pre> ==Definite Clause Grammar== ====narrative( +Solution, +Capacities, +End )/==== is a DCG presenting the water-jugs <var>Solution</var> in a readable format. The grammar is head-recursive because the <var>Solution</var> has the last node outermost. <pre class="prolog"> narrative( start(Start), Capacities, End ) --> "Given three jugs with capacities of:", newline, literal_volumes( Capacities ), "To obtain the result:", newline, literal_volumes( End ), "Starting with:", newline, literal_volumes( Start ), "Do the following:", newline. narrative( node(Transition, Result, Predecessor), Capacities, End ) --> narrative( Predecessor, Capacities, End ), literal_action( Transition, Result ). literal_volumes( Volumes ) --> indent, literal( Volumes ), ";", newline. literal_action( Transition, Result ) --> indent, "- ", literal( Transition ), " giving:", newline, indent, indent, literal( Result ), newline. literal( empty_into(From,To) ) --> "Empty the ", literal( From ), " into the ", literal( To ). literal( fill_from(From,To) ) --> "Fill the ", literal( To ), " from the ", literal( From ). literal( jugs(Small,Large,Reservoir) ) --> literal_number( Small ), " gallons in the small jug, ", literal_number( Large ), " gallons in the large jug and ", literal_number( Reservoir ), " gallons in the reservoir". literal( small ) --> "small jug". literal( large ) --> "large jug". literal( reservoir ) --> "reservoir". literal_number( Number, Plus, Minus ) :- number( Number ), name( Number, Chars ), append( Chars, Minus, Plus ). indent --> " ". newline --> " ". </pre> ==Utility Predicates== Load a small library of [[Puzzle Utilities]]. <pre class="prolog"> :- ensure_loaded( misc ). </pre> The code is available as plain text [https://binding-time.co.uk/download/water_jugs.txt here]. ==Output== The output of the program is: <div class="result"> <pre> ?- water_jugs. Given three jugs with capacities of: 3 gallons in the small jug, 4 gallons in the large jug and 8 gallons in the reservoir; To obtain the result: 0 gallons in the small jug, 2 gallons in the large jug and 6 gallons in the reservoir; Starting with: 0 gallons in the small jug, 0 gallons in the large jug and 8 gallons in the reservoir; Do the following: - Fill the small jug from the reservoir giving: 3 gallons in the small jug, 0 gallons in the large jug and 5 gallons in the reservoir - Empty the small jug into the large jug giving: 0 gallons in the small jug, 3 gallons in the large jug and 5 gallons in the reservoir - Fill the small jug from the reservoir giving: 3 gallons in the small jug, 3 gallons in the large jug and 2 gallons in the reservoir - Fill the large jug from the small jug giving: 2 gallons in the small jug, 4 gallons in the large jug and 2 gallons in the reservoir - Empty the large jug into the reservoir giving: 2 gallons in the small jug, 0 gallons in the large jug and 6 gallons in the reservoir - Empty the small jug into the large jug giving: 0 gallons in the small jug, 2 gallons in the large jug and 6 gallons in the reservoir yes </pre> </div> =====Footnote===== <references/> ffe42a753b5dd03afdc7694e9f857d37300a9a05 8 25 271 2023-07-11T23:17:40Z WikiSysop 1 Disabling Disclaimers wikitext text/x-wiki - 3bc15c8aae3e4124dd409035f32ea2fd6835efc9 0 3 272 230 2023-09-04T11:11:33Z John 2 wikitext text/x-wiki ;John Fletcher's home on the Web __NOTOC__ &ldquo;Prolog is more than a language - it is a way of living :-)&rdquo; Bart Demoen [[Notes]] [[Current]] ==Prolog== Ever since I first learned Prolog, more than 30 years ago, it has been my preferred programming language. ===Why use Prolog?=== Prolog is a tool for solving problems, rather than producing &ldquo;software products&rdquo;, and it will appeal to you if: * You want your programs to be readable, and to have a close correspondence with their specifications; * Statements like x = x + 1 offend your mathematical sensibility; * You like to develop programs incrementally &ndash; with an interactive top-level, interactive debugging, and the ability to test (execute) program fragments independently; * You want fewer lines of code and, therefore, fewer faults; * You prefer to work with a handful of big ideas, rather than a lot of small ones; If you want to find out about Prolog on the Web, you can start with the [[Wikipedia:Prolog|Wikipedia Prolog page]]. Other useful links include: * [[Logic Programming and the Internet]]. Prolog is unequalled as a language for expressing queries and integrity constraints, and for processing text, which make it an excellent choice for Internet applications. * XML documents and Prolog terms have the same &lsquo;tree&rsquo; structure, which makes it easy to program with XML and Prolog. My free code for [[Parsing XML with Prolog]] makes it even easier. * Recommended [[Prolog programming books]]. * My solutions to some puzzles in Prolog: ** [[The Water Jugs Problem]], ** [[The Counterfeit Coin Puzzle]], ** [[Cheating Linguists]]? ** [[Mister X]], ** [[Zoom Tracks]], ** [[Whodunit]]? Although Prolog is regarded as a niche language, it's a very versatile language. I believe that the programming languages used in 2050 will owe more to Prolog than to any other language. 71b8c83b6e03928cd03dd2ec3618032b489e821f 273 272 2023-09-04T11:20:51Z John 2 wikitext text/x-wiki ;John Fletcher's home on the Web __NOTOC__ ==[[Notes]]== == [[Current]]== &ldquo;Prolog is more than a language - it is a way of living :-)&rdquo; Bart Demoen ==Prolog== Ever since I first learned Prolog, more than 30 years ago, it has been my preferred programming language. ===Why use Prolog?=== Prolog is a tool for solving problems, rather than producing &ldquo;software products&rdquo;, and it will appeal to you if: * You want your programs to be readable, and to have a close correspondence with their specifications; * Statements like x = x + 1 offend your mathematical sensibility; * You like to develop programs incrementally &ndash; with an interactive top-level, interactive debugging, and the ability to test (execute) program fragments independently; * You want fewer lines of code and, therefore, fewer faults; * You prefer to work with a handful of big ideas, rather than a lot of small ones; If you want to find out about Prolog on the Web, you can start with the [[Wikipedia:Prolog|Wikipedia Prolog page]]. Other useful links include: * [[Logic Programming and the Internet]]. Prolog is unequalled as a language for expressing queries and integrity constraints, and for processing text, which make it an excellent choice for Internet applications. * XML documents and Prolog terms have the same &lsquo;tree&rsquo; structure, which makes it easy to program with XML and Prolog. My free code for [[Parsing XML with Prolog]] makes it even easier. * Recommended [[Prolog programming books]]. * My solutions to some puzzles in Prolog: ** [[The Water Jugs Problem]], ** [[The Counterfeit Coin Puzzle]], ** [[Cheating Linguists]]? ** [[Mister X]], ** [[Zoom Tracks]], ** [[Whodunit]]? Although Prolog is regarded as a niche language, it's a very versatile language. I believe that the programming languages used in 2050 will owe more to Prolog than to any other language. 774d2b9a45531bd5158435a2c6c8457d9110c365 279 273 2024-01-30T21:45:24Z John 2 /* Current */ wikitext text/x-wiki ;John Fletcher's home on the Web __NOTOC__ ==[[Notes]]== &ldquo;Prolog is more than a language - it is a way of living :-)&rdquo; Bart Demoen ==Prolog== Ever since I first learned Prolog, more than 30 years ago, it has been my preferred programming language. ===Why use Prolog?=== Prolog is a tool for solving problems, rather than producing &ldquo;software products&rdquo;, and it will appeal to you if: * You want your programs to be readable, and to have a close correspondence with their specifications; * Statements like x = x + 1 offend your mathematical sensibility; * You like to develop programs incrementally &ndash; with an interactive top-level, interactive debugging, and the ability to test (execute) program fragments independently; * You want fewer lines of code and, therefore, fewer faults; * You prefer to work with a handful of big ideas, rather than a lot of small ones; If you want to find out about Prolog on the Web, you can start with the [[Wikipedia:Prolog|Wikipedia Prolog page]]. Other useful links include: * [[Logic Programming and the Internet]]. Prolog is unequalled as a language for expressing queries and integrity constraints, and for processing text, which make it an excellent choice for Internet applications. * XML documents and Prolog terms have the same &lsquo;tree&rsquo; structure, which makes it easy to program with XML and Prolog. My free code for [[Parsing XML with Prolog]] makes it even easier. * Recommended [[Prolog programming books]]. * My solutions to some puzzles in Prolog: ** [[The Water Jugs Problem]], ** [[The Counterfeit Coin Puzzle]], ** [[Cheating Linguists]]? ** [[Mister X]], ** [[Zoom Tracks]], ** [[Whodunit]]? Although Prolog is regarded as a niche language, it's a very versatile language. I believe that the programming languages used in 2050 will owe more to Prolog than to any other language. 71b34ae806d68b7765b4f90d3eb9c278e6cf2aca 296 279 2024-11-23T20:49:40Z John 2 wikitext text/x-wiki ;John Fletcher's home on the Web __NOTOC__ &ldquo;Prolog is more than a language - it is a way of living :-)&rdquo; Bart Demoen ==Prolog== Ever since I first learned Prolog, more than 30 years ago, it has been my preferred programming language. ===Why use Prolog?=== Prolog is a tool for solving problems, rather than producing &ldquo;software products&rdquo;, and it will appeal to you if: * You want your programs to be readable, and to have a close correspondence with their specifications; * Statements like x = x + 1 offend your mathematical sensibility; * You like to develop programs incrementally &ndash; with an interactive top-level, interactive debugging, and the ability to test (execute) program fragments independently; * You want fewer lines of code and, therefore, fewer faults; * You prefer to work with a handful of big ideas, rather than a lot of small ones; If you want to find out about Prolog on the Web, you can start with the [[Wikipedia:Prolog|Wikipedia Prolog page]]. Other useful links include: * [[Logic Programming and the Internet]]. Prolog is unequalled as a language for expressing queries and integrity constraints, and for processing text, which make it an excellent choice for Internet applications. * XML documents and Prolog terms have the same &lsquo;tree&rsquo; structure, which makes it easy to program with XML and Prolog. My free code for [[Parsing XML with Prolog]] makes it even easier. * Recommended [[Prolog programming books]]. * My solutions to some puzzles in Prolog: ** [[The Water Jugs Problem]], ** [[The Counterfeit Coin Puzzle]], ** [[Cheating Linguists]]? ** [[Mister X]], ** [[Zoom Tracks]], ** [[Whodunit]]? Although Prolog is regarded as a niche language, it's a very versatile language. I believe that the programming languages used in 2050 will owe more to Prolog than to any other language. 13897c1916142ba6448fcc6096f2388be0296238 299 296 2025-01-15T19:21:30Z John 2 /* 30 years -> 40 years */ wikitext text/x-wiki ;John Fletcher's home on the Web __NOTOC__ &ldquo;Prolog is more than a language - it is a way of living :-)&rdquo; Bart Demoen ==Prolog== Ever since I first learned Prolog, more than 40 years ago, it has been my preferred programming language. ===Why use Prolog?=== Prolog is a tool for solving problems, rather than producing &ldquo;software products&rdquo;, and it will appeal to you if: * You want your programs to be readable, and to have a close correspondence with their specifications; * Statements like x = x + 1 offend your mathematical sensibility; * You like to develop programs incrementally &ndash; with an interactive top-level, interactive debugging, and the ability to test (execute) program fragments independently; * You want fewer lines of code and, therefore, fewer faults; * You prefer to work with a handful of big ideas, rather than a lot of small ones; If you want to find out about Prolog on the Web, you can start with the [[Wikipedia:Prolog|Wikipedia Prolog page]]. Other useful links include: * [[Logic Programming and the Internet]]. Prolog is unequalled as a language for expressing queries and integrity constraints, and for processing text, which make it an excellent choice for Internet applications. * XML documents and Prolog terms have the same &lsquo;tree&rsquo; structure, which makes it easy to program with XML and Prolog. My free code for [[Parsing XML with Prolog]] makes it even easier. * Recommended [[Prolog programming books]]. * My solutions to some puzzles in Prolog: ** [[The Water Jugs Problem]], ** [[The Counterfeit Coin Puzzle]], ** [[Cheating Linguists]]? ** [[Mister X]], ** [[Zoom Tracks]], ** [[Whodunit]]? Although Prolog is regarded as a niche language, it's a very versatile language. I believe that the programming languages used in 2050 will owe more to Prolog than to any other language. 70f6358eba312184fbad9bc3a1b4da892da5322d 0 13 282 213 2024-03-01T20:09:45Z John 2 wikitext text/x-wiki __NOTOC__ Although this problem has a straightforward solution, it does demonstrate the value of thinking deductively to understand the problem, which relates to &ldquo;don't know&rdquo; nondeterminism, and an appropriate use of lemmas. == Problem: == [https://groups.google.com/forum/#!msg/de.comp.lang.java/xQ6T3kZGqcE/-OTNgyB8yxIJ Problem as posted to comp.lang.prolog] by Thorsten Seelend. Also known as Hans Freudenthal's [[wikipedia:Impossible Puzzle|Impossible Puzzle]]. <blockquote>Mister X thinks about two integers between 1 and 100 excluding: </blockquote> =====MISTERX: Two integers, X and Y between 2 and 99 (My formalization of the given information)===== <pre class="prolog">two_integers( X, Y ) :- between( 2, 98, X ), between( X, 99, Y ).</pre> He tells Susan the Sum of them and Peter their Product. Their task is to get the two original values without telling each other the numbers that Mister X told them. <blockquote>After some time Peter says: &ldquo;I can't say definitively which are the original numbers.&rdquo;</blockquote> =====PETER1: There is more than one pair of factors giving Product===== <pre class="prolog">property( peter1, Product ) :- \+ unique_factors( Product ).</pre> <blockquote>Then Susan responds: &ldquo;Neither can I, but I knew that you couldn't know it.&rdquo;</blockquote> =====SUSAN1: The product of ''every'' pair of summands giving Sum has the property PETER1===== <pre class="prolog">property( susan1, Sum ) :- forall( ordered_summands(Sum, X, Y), peter1(X * Y) ).</pre> <blockquote>Peter: &ldquo;Really? So now I know the original numbers&rdquo;.</blockquote> =====PETER2: ''exactly one'' pair of factors giving Product gives a sum with the property SUSAN1===== <pre class="prolog">property( peter2, Product ) :- unique_solution( (ordered_factors(Product, X, Y), susan1(X+Y)) ).</pre> <blockquote>Susan: &ldquo;Now I know them too&rdquo;.</blockquote> =====SUSAN2: ''exactly one'' pair of summands giving Sum has a product with the property PETER2===== <pre class="prolog">property( susan2, Sum ) :- unique_solution( (ordered_summands(Sum, X, Y), peter2(X * Y)) ).</pre> <blockquote>Question: What are the two numbers that Mister X thought of?</blockquote> =====Unique solution===== <pre class="prolog">solve( X, Y ) :- unique_solution( mister_x(X, Y) ). mister_x( X, Y ) :- two_integers( X, Y ), Sum is X + Y, Product is X * Y, peter1( Product ), susan1( Sum ), peter2( Product ), susan2( Sum ).</pre> == Macros == <pre class="prolog">peter1( Product ) :- lemma( peter1, Product ). peter2( Product ) :- lemma( peter2, Product ). susan1( Sum ) :- lemma( susan1, Sum ). susan2( Sum ) :- lemma( susan2, Sum ).</pre> == Lemmas == ====lemma( +Property, +Expression )==== holds wherever <var>Property</var> holds for <var>Expression</var>. Asserted facts are used to record successful (''positive'') or failed (''negative'') demonstrations. This saves recomputation without changing the meaning of the pure program. Although the use of side-effects is generally undesirable, the use of lemmas is justified when the alternative is to compromise performance or clarity. Using lemmas or tabling to cache results is an order of magnitude faster than recalculating each property every time it is used. <pre class="prolog">:- dynamic positive/2, negative/2. lemma( Name, Expression ) :- Value is Expression, ( positive( Value, Name ) -> true ; \+ negative( Value, Name ) -> ( property(Name, Value) -> assert( positive(Value, Name) ) ; otherwise -> assert( negative(Value, Name) ), fail ) ).</pre> == Supporting Predicates == ====ordered_summands( +Sum, ?X, ?Y )==== when <var>X</var> &le; <var>Y</var> and Sum = <var>X</var>+<var>Y</var>. NB: Since <var>X</var>&le;<var>Y</var> it follows that <var>X</var> &le; <var>Sum</var>/2. <pre class="prolog">ordered_summands( Z, X, Y ) :- Half is Z//2, between( 2, Half, X ), Y is Z - X, between( X, 98, Y ).</pre> ====ordered_factors( +Product, ?X, ?Y )==== when <var>X</var> &le; <var>Y</var> and <var>Product</var> = <var>X</var> &times; <var>Y</var>. NB: Since <var>X</var>&le;<var>Y</var> it follows that <var>X</var> &le; &radic;<var>Product</var>. <pre class="prolog">ordered_factors( Z, X, Y ) :- integer_sqrt( Z, SqrtZ ), between( 2, SqrtZ, X ), Y is Z // X, between( X, 99, Y ), Z =:= X * Y.</pre> ====unique_factors( +Product )==== when <var>Product</var> has exactly one pair of factors. <pre class="prolog">unique_factors( Product ) :- ordered_factors( Product, X, _Y ), \+ (ordered_factors(Product, X1, _Y1), X1 =\= X).</pre> ====integer_sqrt( +N, ?Sqrt )==== when <var>Sqrt</var>² &le; <var>N</var> &lt; (<var>Sqrt</var>+1)². <pre class="prolog">integer_sqrt( N, Sqrt ) :- Float is N * 1.0, sqrt( Float, FSqrt ), Sqrt is integer(FSqrt).</pre> Load a small library of [[Puzzle Utilities]]. <pre class="prolog">:- ensure_loaded( misc ).</pre> The code is available as plain text [https://binding-time.co.uk/download/mister_x.txt here]. == Result == This program finds X and Y as '''4''' and '''13'''. == Tabling == Using tabling, rather than explicit lemmas, can simplify code. [https://binding-time.co.uk/download/xsb_mister_x.txt A version adapted for XSB Prolog is available here.] c0c04ca07e4312d4ad2b274b2ffa9ac0caefd243 0 27 283 2024-03-01T20:11:14Z John 2 Created page with "__NOTOC__ Although this problem has a straightforward solution, it does demonstrate the value of thinking deductively to understand the problem, which relates to &ldquo;don't know&rdquo; nondeterminism, and an appropriate use of lemmas. == Problem: == [https://groups.google.com/forum/#!msg/de.comp.lang.java/xQ6T3kZGqcE/-OTNgyB8yxIJ Problem as posted to comp.lang.prolog] by Thorsten Seelend. Also known as Hans Freudenthal's [[wikipedia:Impossible Puzzle|Impossible Puzzle]..." wikitext text/x-wiki __NOTOC__ Although this problem has a straightforward solution, it does demonstrate the value of thinking deductively to understand the problem, which relates to &ldquo;don't know&rdquo; nondeterminism, and an appropriate use of lemmas. == Problem: == [https://groups.google.com/forum/#!msg/de.comp.lang.java/xQ6T3kZGqcE/-OTNgyB8yxIJ Problem as posted to comp.lang.prolog] by Thorsten Seelend. Also known as Hans Freudenthal's [[wikipedia:Impossible Puzzle|Impossible Puzzle]]. <blockquote>Mister X thinks about two integers between 1 and 100 excluding: </blockquote> =====MISTERX: Two integers, X and Y between 2 and 99 (My formalization of the given information)===== <pre class="prolog">two_integers( X, Y ) :- between( 2, 98, X ), between( X, 99, Y ).</pre> He tells Susan the Sum of them and Peter their Product. Their task is to get the two original values without telling each other the numbers that Mister X told them. <blockquote>After some time Peter says: &ldquo;I can't say definitively which are the original numbers.&rdquo;</blockquote> =====PETER1: There is more than one pair of factors giving Product===== <pre class="prolog">property( peter1, Product ) :- \+ unique_factors( Product ).</pre> <blockquote>Then Susan responds: &ldquo;Neither can I, but I knew that you couldn't know it.&rdquo;</blockquote> =====SUSAN1: The product of ''every'' pair of summands giving Sum has the property PETER1===== <pre class="prolog">property( susan1, Sum ) :- forall( ordered_summands(Sum, X, Y), peter1(X * Y) ).</pre> <blockquote>Peter: &ldquo;Really? So now I know the original numbers&rdquo;.</blockquote> =====PETER2: ''exactly one'' pair of factors giving Product gives a sum with the property SUSAN1===== <pre class="prolog">property( peter2, Product ) :- unique_solution( (ordered_factors(Product, X, Y), susan1(X+Y)) ).</pre> <blockquote>Susan: &ldquo;Now I know them too&rdquo;.</blockquote> =====SUSAN2: ''exactly one'' pair of summands giving Sum has a product with the property PETER2===== <pre class="prolog">property( susan2, Sum ) :- unique_solution( (ordered_summands(Sum, X, Y), peter2(X * Y)) ).</pre> <blockquote>Question: What are the two numbers that Mister X thought of?</blockquote> =====Unique solution===== <pre class="prolog">solve( X, Y ) :- unique_solution( mister_x(X, Y) ). mister_x( X, Y ) :- two_integers( X, Y ), Sum is X + Y, Product is X * Y, peter1( Product ), susan1( Sum ), peter2( Product ), susan2( Sum ).</pre> == Macros == <pre class="prolog">peter1( Product ) :- lemma( peter1, Product ). peter2( Product ) :- lemma( peter2, Product ). susan1( Sum ) :- lemma( susan1, Sum ). susan2( Sum ) :- lemma( susan2, Sum ).</pre> == Lemmas == ====lemma( +Property, +Expression )==== holds wherever <var>Property</var> holds for <var>Expression</var>. Asserted facts are used to record successful (''positive'') or failed (''negative'') demonstrations. This saves recomputation without changing the meaning of the pure program. Although the use of side-effects is generally undesirable, the use of lemmas is justified when the alternative is to compromise performance or clarity. Using lemmas or tabling to cache results is an order of magnitude faster than recalculating each property every time it is used. <pre class="prolog">:- dynamic positive/2, negative/2. lemma( Name, Expression ) :- Value is Expression, ( positive( Value, Name ) -> true ; \+ negative( Value, Name ) -> ( property(Name, Value) -> assert( positive(Value, Name) ) ; otherwise -> assert( negative(Value, Name) ), fail ) ).</pre> == Supporting Predicates == ====ordered_summands( +Sum, ?X, ?Y )==== when <var>X</var> &le; <var>Y</var> and Sum = <var>X</var>+<var>Y</var>. NB: Since <var>X</var>&le;<var>Y</var> it follows that <var>X</var> &le; <var>Sum</var>/2. <pre class="prolog">ordered_summands( Z, X, Y ) :- Half is Z//2, between( 2, Half, X ), Y is Z - X, between( X, 98, Y ).</pre> ====ordered_factors( +Product, ?X, ?Y )==== when <var>X</var> &le; <var>Y</var> and <var>Product</var> = <var>X</var> &times; <var>Y</var>. NB: Since <var>X</var>&le;<var>Y</var> it follows that <var>X</var> &le; &radic;<var>Product</var>. <pre class="prolog">ordered_factors( Z, X, Y ) :- integer_sqrt( Z, SqrtZ ), between( 2, SqrtZ, X ), Y is Z // X, between( X, 99, Y ), Z =:= X * Y.</pre> ====unique_factors( +Product )==== when <var>Product</var> has exactly one pair of factors. <pre class="prolog">unique_factors( Product ) :- ordered_factors( Product, X, _Y ), \+ (ordered_factors(Product, X1, _Y1), X1 =\= X).</pre> ====integer_sqrt( +N, ?Sqrt )==== when <var>Sqrt</var>² &le; <var>N</var> &lt; (<var>Sqrt</var>+1)². <pre class="prolog">integer_sqrt( N, Sqrt ) :- Float is N * 1.0, sqrt( Float, FSqrt ), Sqrt is integer(FSqrt).</pre> Load a small library of [[Puzzle Utilities]]. <pre class="prolog">:- ensure_loaded( misc ).</pre> The code is available as plain text [https://binding-time.co.uk/download/mister_x.txt here]. == Result == This program finds X and Y as '''4''' and '''13'''. == Tabling == Using tabling, rather than explicit lemmas, can simplify code. [https://binding-time.co.uk/download/xsb_mister_x.txt A version adapted for XSB Prolog is available here.] c0c04ca07e4312d4ad2b274b2ffa9ac0caefd243 284 283 2024-03-01T20:11:50Z John 2 /* PETER1: There is more than one pair of factors giving Product */ wikitext text/x-wiki __NOTOC__ Although this problem has a straightforward solution, it does demonstrate the value of thinking deductively to understand the problem, which relates to &ldquo;don't know&rdquo; nondeterminism, and an appropriate use of lemmas. == Problem: == [https://groups.google.com/forum/#!msg/de.comp.lang.java/xQ6T3kZGqcE/-OTNgyB8yxIJ Problem as posted to comp.lang.prolog] by Thorsten Seelend. Also known as Hans Freudenthal's [[wikipedia:Impossible Puzzle|Impossible Puzzle]]. <blockquote>Mister X thinks about two integers between 1 and 100 excluding: </blockquote> =====MISTERX: Two integers, X and Y between 2 and 99 (My formalization of the given information)===== <pre class="prolog">two_integers( X, Y ) :- between( 2, 98, X ), between( X, 99, Y ).</pre> He tells Susan the Sum of them and Peter their Product. Their task is to get the two original values without telling each other the numbers that Mister X told them. <blockquote>After some time Peter says: &ldquo;I can't say definitively which are the original numbers.&rdquo;</blockquote> =====PETER1: There is more than one pair of factors giving Product===== <pre class="prolog">:- table peter1/1. peter1( Product ) :- \+ unique_factors( Product ). </pre> <blockquote>Then Susan responds: &ldquo;Neither can I, but I knew that you couldn't know it.&rdquo;</blockquote> =====SUSAN1: The product of ''every'' pair of summands giving Sum has the property PETER1===== <pre class="prolog">property( susan1, Sum ) :- forall( ordered_summands(Sum, X, Y), peter1(X * Y) ).</pre> <blockquote>Peter: &ldquo;Really? So now I know the original numbers&rdquo;.</blockquote> =====PETER2: ''exactly one'' pair of factors giving Product gives a sum with the property SUSAN1===== <pre class="prolog">property( peter2, Product ) :- unique_solution( (ordered_factors(Product, X, Y), susan1(X+Y)) ).</pre> <blockquote>Susan: &ldquo;Now I know them too&rdquo;.</blockquote> =====SUSAN2: ''exactly one'' pair of summands giving Sum has a product with the property PETER2===== <pre class="prolog">property( susan2, Sum ) :- unique_solution( (ordered_summands(Sum, X, Y), peter2(X * Y)) ).</pre> <blockquote>Question: What are the two numbers that Mister X thought of?</blockquote> =====Unique solution===== <pre class="prolog">solve( X, Y ) :- unique_solution( mister_x(X, Y) ). mister_x( X, Y ) :- two_integers( X, Y ), Sum is X + Y, Product is X * Y, peter1( Product ), susan1( Sum ), peter2( Product ), susan2( Sum ).</pre> == Macros == <pre class="prolog">peter1( Product ) :- lemma( peter1, Product ). peter2( Product ) :- lemma( peter2, Product ). susan1( Sum ) :- lemma( susan1, Sum ). susan2( Sum ) :- lemma( susan2, Sum ).</pre> == Lemmas == ====lemma( +Property, +Expression )==== holds wherever <var>Property</var> holds for <var>Expression</var>. Asserted facts are used to record successful (''positive'') or failed (''negative'') demonstrations. This saves recomputation without changing the meaning of the pure program. Although the use of side-effects is generally undesirable, the use of lemmas is justified when the alternative is to compromise performance or clarity. Using lemmas or tabling to cache results is an order of magnitude faster than recalculating each property every time it is used. <pre class="prolog">:- dynamic positive/2, negative/2. lemma( Name, Expression ) :- Value is Expression, ( positive( Value, Name ) -> true ; \+ negative( Value, Name ) -> ( property(Name, Value) -> assert( positive(Value, Name) ) ; otherwise -> assert( negative(Value, Name) ), fail ) ).</pre> == Supporting Predicates == ====ordered_summands( +Sum, ?X, ?Y )==== when <var>X</var> &le; <var>Y</var> and Sum = <var>X</var>+<var>Y</var>. NB: Since <var>X</var>&le;<var>Y</var> it follows that <var>X</var> &le; <var>Sum</var>/2. <pre class="prolog">ordered_summands( Z, X, Y ) :- Half is Z//2, between( 2, Half, X ), Y is Z - X, between( X, 98, Y ).</pre> ====ordered_factors( +Product, ?X, ?Y )==== when <var>X</var> &le; <var>Y</var> and <var>Product</var> = <var>X</var> &times; <var>Y</var>. NB: Since <var>X</var>&le;<var>Y</var> it follows that <var>X</var> &le; &radic;<var>Product</var>. <pre class="prolog">ordered_factors( Z, X, Y ) :- integer_sqrt( Z, SqrtZ ), between( 2, SqrtZ, X ), Y is Z // X, between( X, 99, Y ), Z =:= X * Y.</pre> ====unique_factors( +Product )==== when <var>Product</var> has exactly one pair of factors. <pre class="prolog">unique_factors( Product ) :- ordered_factors( Product, X, _Y ), \+ (ordered_factors(Product, X1, _Y1), X1 =\= X).</pre> ====integer_sqrt( +N, ?Sqrt )==== when <var>Sqrt</var>² &le; <var>N</var> &lt; (<var>Sqrt</var>+1)². <pre class="prolog">integer_sqrt( N, Sqrt ) :- Float is N * 1.0, sqrt( Float, FSqrt ), Sqrt is integer(FSqrt).</pre> Load a small library of [[Puzzle Utilities]]. <pre class="prolog">:- ensure_loaded( misc ).</pre> The code is available as plain text [https://binding-time.co.uk/download/mister_x.txt here]. == Result == This program finds X and Y as '''4''' and '''13'''. == Tabling == Using tabling, rather than explicit lemmas, can simplify code. [https://binding-time.co.uk/download/xsb_mister_x.txt A version adapted for XSB Prolog is available here.] c9683df63d23a2967e1f8b19fbb0a4c42ed1e679 285 284 2024-03-01T20:12:28Z John 2 /* SUSAN1: The product of every pair of summands giving Sum has the property PETER1 */ wikitext text/x-wiki __NOTOC__ Although this problem has a straightforward solution, it does demonstrate the value of thinking deductively to understand the problem, which relates to &ldquo;don't know&rdquo; nondeterminism, and an appropriate use of lemmas. == Problem: == [https://groups.google.com/forum/#!msg/de.comp.lang.java/xQ6T3kZGqcE/-OTNgyB8yxIJ Problem as posted to comp.lang.prolog] by Thorsten Seelend. Also known as Hans Freudenthal's [[wikipedia:Impossible Puzzle|Impossible Puzzle]]. <blockquote>Mister X thinks about two integers between 1 and 100 excluding: </blockquote> =====MISTERX: Two integers, X and Y between 2 and 99 (My formalization of the given information)===== <pre class="prolog">two_integers( X, Y ) :- between( 2, 98, X ), between( X, 99, Y ).</pre> He tells Susan the Sum of them and Peter their Product. Their task is to get the two original values without telling each other the numbers that Mister X told them. <blockquote>After some time Peter says: &ldquo;I can't say definitively which are the original numbers.&rdquo;</blockquote> =====PETER1: There is more than one pair of factors giving Product===== <pre class="prolog">:- table peter1/1. peter1( Product ) :- \+ unique_factors( Product ). </pre> <blockquote>Then Susan responds: &ldquo;Neither can I, but I knew that you couldn't know it.&rdquo;</blockquote> =====SUSAN1: The product of ''every'' pair of summands giving Sum has the property PETER1===== <pre class="prolog">:- table susan1/1. susan1( Sum ) :- forall( ordered_summands(Sum, X, Y), peter1(X * Y) ). </pre> <blockquote>Peter: &ldquo;Really? So now I know the original numbers&rdquo;.</blockquote> =====PETER2: ''exactly one'' pair of factors giving Product gives a sum with the property SUSAN1===== <pre class="prolog">property( peter2, Product ) :- unique_solution( (ordered_factors(Product, X, Y), susan1(X+Y)) ).</pre> <blockquote>Susan: &ldquo;Now I know them too&rdquo;.</blockquote> =====SUSAN2: ''exactly one'' pair of summands giving Sum has a product with the property PETER2===== <pre class="prolog">property( susan2, Sum ) :- unique_solution( (ordered_summands(Sum, X, Y), peter2(X * Y)) ).</pre> <blockquote>Question: What are the two numbers that Mister X thought of?</blockquote> =====Unique solution===== <pre class="prolog">solve( X, Y ) :- unique_solution( mister_x(X, Y) ). mister_x( X, Y ) :- two_integers( X, Y ), Sum is X + Y, Product is X * Y, peter1( Product ), susan1( Sum ), peter2( Product ), susan2( Sum ).</pre> == Macros == <pre class="prolog">peter1( Product ) :- lemma( peter1, Product ). peter2( Product ) :- lemma( peter2, Product ). susan1( Sum ) :- lemma( susan1, Sum ). susan2( Sum ) :- lemma( susan2, Sum ).</pre> == Lemmas == ====lemma( +Property, +Expression )==== holds wherever <var>Property</var> holds for <var>Expression</var>. Asserted facts are used to record successful (''positive'') or failed (''negative'') demonstrations. This saves recomputation without changing the meaning of the pure program. Although the use of side-effects is generally undesirable, the use of lemmas is justified when the alternative is to compromise performance or clarity. Using lemmas or tabling to cache results is an order of magnitude faster than recalculating each property every time it is used. <pre class="prolog">:- dynamic positive/2, negative/2. lemma( Name, Expression ) :- Value is Expression, ( positive( Value, Name ) -> true ; \+ negative( Value, Name ) -> ( property(Name, Value) -> assert( positive(Value, Name) ) ; otherwise -> assert( negative(Value, Name) ), fail ) ).</pre> == Supporting Predicates == ====ordered_summands( +Sum, ?X, ?Y )==== when <var>X</var> &le; <var>Y</var> and Sum = <var>X</var>+<var>Y</var>. NB: Since <var>X</var>&le;<var>Y</var> it follows that <var>X</var> &le; <var>Sum</var>/2. <pre class="prolog">ordered_summands( Z, X, Y ) :- Half is Z//2, between( 2, Half, X ), Y is Z - X, between( X, 98, Y ).</pre> ====ordered_factors( +Product, ?X, ?Y )==== when <var>X</var> &le; <var>Y</var> and <var>Product</var> = <var>X</var> &times; <var>Y</var>. NB: Since <var>X</var>&le;<var>Y</var> it follows that <var>X</var> &le; &radic;<var>Product</var>. <pre class="prolog">ordered_factors( Z, X, Y ) :- integer_sqrt( Z, SqrtZ ), between( 2, SqrtZ, X ), Y is Z // X, between( X, 99, Y ), Z =:= X * Y.</pre> ====unique_factors( +Product )==== when <var>Product</var> has exactly one pair of factors. <pre class="prolog">unique_factors( Product ) :- ordered_factors( Product, X, _Y ), \+ (ordered_factors(Product, X1, _Y1), X1 =\= X).</pre> ====integer_sqrt( +N, ?Sqrt )==== when <var>Sqrt</var>² &le; <var>N</var> &lt; (<var>Sqrt</var>+1)². <pre class="prolog">integer_sqrt( N, Sqrt ) :- Float is N * 1.0, sqrt( Float, FSqrt ), Sqrt is integer(FSqrt).</pre> Load a small library of [[Puzzle Utilities]]. <pre class="prolog">:- ensure_loaded( misc ).</pre> The code is available as plain text [https://binding-time.co.uk/download/mister_x.txt here]. == Result == This program finds X and Y as '''4''' and '''13'''. == Tabling == Using tabling, rather than explicit lemmas, can simplify code. [https://binding-time.co.uk/download/xsb_mister_x.txt A version adapted for XSB Prolog is available here.] 8696b38c926c03e0a4aa3c67e7f2567f926c3242 286 285 2024-03-01T20:13:11Z John 2 /* PETER2: exactly one pair of factors giving Product gives a sum with the property SUSAN1 */ wikitext text/x-wiki __NOTOC__ Although this problem has a straightforward solution, it does demonstrate the value of thinking deductively to understand the problem, which relates to &ldquo;don't know&rdquo; nondeterminism, and an appropriate use of lemmas. == Problem: == [https://groups.google.com/forum/#!msg/de.comp.lang.java/xQ6T3kZGqcE/-OTNgyB8yxIJ Problem as posted to comp.lang.prolog] by Thorsten Seelend. Also known as Hans Freudenthal's [[wikipedia:Impossible Puzzle|Impossible Puzzle]]. <blockquote>Mister X thinks about two integers between 1 and 100 excluding: </blockquote> =====MISTERX: Two integers, X and Y between 2 and 99 (My formalization of the given information)===== <pre class="prolog">two_integers( X, Y ) :- between( 2, 98, X ), between( X, 99, Y ).</pre> He tells Susan the Sum of them and Peter their Product. Their task is to get the two original values without telling each other the numbers that Mister X told them. <blockquote>After some time Peter says: &ldquo;I can't say definitively which are the original numbers.&rdquo;</blockquote> =====PETER1: There is more than one pair of factors giving Product===== <pre class="prolog">:- table peter1/1. peter1( Product ) :- \+ unique_factors( Product ). </pre> <blockquote>Then Susan responds: &ldquo;Neither can I, but I knew that you couldn't know it.&rdquo;</blockquote> =====SUSAN1: The product of ''every'' pair of summands giving Sum has the property PETER1===== <pre class="prolog">:- table susan1/1. susan1( Sum ) :- forall( ordered_summands(Sum, X, Y), peter1(X * Y) ). </pre> <blockquote>Peter: &ldquo;Really? So now I know the original numbers&rdquo;.</blockquote> =====PETER2: ''exactly one'' pair of factors giving Product gives a sum with the property SUSAN1===== <pre class="prolog">:- table peter2/1. peter2( Product ) :- unique_solution( (ordered_factors(Product, X, Y), susan1(X+Y)) ).</pre> <blockquote>Susan: &ldquo;Now I know them too&rdquo;.</blockquote> =====SUSAN2: ''exactly one'' pair of summands giving Sum has a product with the property PETER2===== <pre class="prolog">property( susan2, Sum ) :- unique_solution( (ordered_summands(Sum, X, Y), peter2(X * Y)) ).</pre> <blockquote>Question: What are the two numbers that Mister X thought of?</blockquote> =====Unique solution===== <pre class="prolog">solve( X, Y ) :- unique_solution( mister_x(X, Y) ). mister_x( X, Y ) :- two_integers( X, Y ), Sum is X + Y, Product is X * Y, peter1( Product ), susan1( Sum ), peter2( Product ), susan2( Sum ).</pre> == Macros == <pre class="prolog">peter1( Product ) :- lemma( peter1, Product ). peter2( Product ) :- lemma( peter2, Product ). susan1( Sum ) :- lemma( susan1, Sum ). susan2( Sum ) :- lemma( susan2, Sum ).</pre> == Lemmas == ====lemma( +Property, +Expression )==== holds wherever <var>Property</var> holds for <var>Expression</var>. Asserted facts are used to record successful (''positive'') or failed (''negative'') demonstrations. This saves recomputation without changing the meaning of the pure program. Although the use of side-effects is generally undesirable, the use of lemmas is justified when the alternative is to compromise performance or clarity. Using lemmas or tabling to cache results is an order of magnitude faster than recalculating each property every time it is used. <pre class="prolog">:- dynamic positive/2, negative/2. lemma( Name, Expression ) :- Value is Expression, ( positive( Value, Name ) -> true ; \+ negative( Value, Name ) -> ( property(Name, Value) -> assert( positive(Value, Name) ) ; otherwise -> assert( negative(Value, Name) ), fail ) ).</pre> == Supporting Predicates == ====ordered_summands( +Sum, ?X, ?Y )==== when <var>X</var> &le; <var>Y</var> and Sum = <var>X</var>+<var>Y</var>. NB: Since <var>X</var>&le;<var>Y</var> it follows that <var>X</var> &le; <var>Sum</var>/2. <pre class="prolog">ordered_summands( Z, X, Y ) :- Half is Z//2, between( 2, Half, X ), Y is Z - X, between( X, 98, Y ).</pre> ====ordered_factors( +Product, ?X, ?Y )==== when <var>X</var> &le; <var>Y</var> and <var>Product</var> = <var>X</var> &times; <var>Y</var>. NB: Since <var>X</var>&le;<var>Y</var> it follows that <var>X</var> &le; &radic;<var>Product</var>. <pre class="prolog">ordered_factors( Z, X, Y ) :- integer_sqrt( Z, SqrtZ ), between( 2, SqrtZ, X ), Y is Z // X, between( X, 99, Y ), Z =:= X * Y.</pre> ====unique_factors( +Product )==== when <var>Product</var> has exactly one pair of factors. <pre class="prolog">unique_factors( Product ) :- ordered_factors( Product, X, _Y ), \+ (ordered_factors(Product, X1, _Y1), X1 =\= X).</pre> ====integer_sqrt( +N, ?Sqrt )==== when <var>Sqrt</var>² &le; <var>N</var> &lt; (<var>Sqrt</var>+1)². <pre class="prolog">integer_sqrt( N, Sqrt ) :- Float is N * 1.0, sqrt( Float, FSqrt ), Sqrt is integer(FSqrt).</pre> Load a small library of [[Puzzle Utilities]]. <pre class="prolog">:- ensure_loaded( misc ).</pre> The code is available as plain text [https://binding-time.co.uk/download/mister_x.txt here]. == Result == This program finds X and Y as '''4''' and '''13'''. == Tabling == Using tabling, rather than explicit lemmas, can simplify code. [https://binding-time.co.uk/download/xsb_mister_x.txt A version adapted for XSB Prolog is available here.] c4ea11f4f8f6c4384cdabdfc9749045cc3343525 287 286 2024-03-01T20:13:55Z John 2 /* SUSAN2: exactly one pair of summands giving Sum has a product with the property PETER2 */ wikitext text/x-wiki __NOTOC__ Although this problem has a straightforward solution, it does demonstrate the value of thinking deductively to understand the problem, which relates to &ldquo;don't know&rdquo; nondeterminism, and an appropriate use of lemmas. == Problem: == [https://groups.google.com/forum/#!msg/de.comp.lang.java/xQ6T3kZGqcE/-OTNgyB8yxIJ Problem as posted to comp.lang.prolog] by Thorsten Seelend. Also known as Hans Freudenthal's [[wikipedia:Impossible Puzzle|Impossible Puzzle]]. <blockquote>Mister X thinks about two integers between 1 and 100 excluding: </blockquote> =====MISTERX: Two integers, X and Y between 2 and 99 (My formalization of the given information)===== <pre class="prolog">two_integers( X, Y ) :- between( 2, 98, X ), between( X, 99, Y ).</pre> He tells Susan the Sum of them and Peter their Product. Their task is to get the two original values without telling each other the numbers that Mister X told them. <blockquote>After some time Peter says: &ldquo;I can't say definitively which are the original numbers.&rdquo;</blockquote> =====PETER1: There is more than one pair of factors giving Product===== <pre class="prolog">:- table peter1/1. peter1( Product ) :- \+ unique_factors( Product ). </pre> <blockquote>Then Susan responds: &ldquo;Neither can I, but I knew that you couldn't know it.&rdquo;</blockquote> =====SUSAN1: The product of ''every'' pair of summands giving Sum has the property PETER1===== <pre class="prolog">:- table susan1/1. susan1( Sum ) :- forall( ordered_summands(Sum, X, Y), peter1(X * Y) ). </pre> <blockquote>Peter: &ldquo;Really? So now I know the original numbers&rdquo;.</blockquote> =====PETER2: ''exactly one'' pair of factors giving Product gives a sum with the property SUSAN1===== <pre class="prolog">:- table peter2/1. peter2( Product ) :- unique_solution( (ordered_factors(Product, X, Y), susan1(X+Y)) ).</pre> <blockquote>Susan: &ldquo;Now I know them too&rdquo;.</blockquote> =====SUSAN2: ''exactly one'' pair of summands giving Sum has a product with the property PETER2===== <pre class="prolog">:- table susan2/1. susan2( Sum ) :- unique_solution( (ordered_summands(Sum, X, Y), peter2(X * Y)) ).</pre> <blockquote>Question: What are the two numbers that Mister X thought of?</blockquote> =====Unique solution===== <pre class="prolog">solve( X, Y ) :- unique_solution( mister_x(X, Y) ). mister_x( X, Y ) :- two_integers( X, Y ), Sum is X + Y, Product is X * Y, peter1( Product ), susan1( Sum ), peter2( Product ), susan2( Sum ).</pre> == Macros == <pre class="prolog">peter1( Product ) :- lemma( peter1, Product ). peter2( Product ) :- lemma( peter2, Product ). susan1( Sum ) :- lemma( susan1, Sum ). susan2( Sum ) :- lemma( susan2, Sum ).</pre> == Lemmas == ====lemma( +Property, +Expression )==== holds wherever <var>Property</var> holds for <var>Expression</var>. Asserted facts are used to record successful (''positive'') or failed (''negative'') demonstrations. This saves recomputation without changing the meaning of the pure program. Although the use of side-effects is generally undesirable, the use of lemmas is justified when the alternative is to compromise performance or clarity. Using lemmas or tabling to cache results is an order of magnitude faster than recalculating each property every time it is used. <pre class="prolog">:- dynamic positive/2, negative/2. lemma( Name, Expression ) :- Value is Expression, ( positive( Value, Name ) -> true ; \+ negative( Value, Name ) -> ( property(Name, Value) -> assert( positive(Value, Name) ) ; otherwise -> assert( negative(Value, Name) ), fail ) ).</pre> == Supporting Predicates == ====ordered_summands( +Sum, ?X, ?Y )==== when <var>X</var> &le; <var>Y</var> and Sum = <var>X</var>+<var>Y</var>. NB: Since <var>X</var>&le;<var>Y</var> it follows that <var>X</var> &le; <var>Sum</var>/2. <pre class="prolog">ordered_summands( Z, X, Y ) :- Half is Z//2, between( 2, Half, X ), Y is Z - X, between( X, 98, Y ).</pre> ====ordered_factors( +Product, ?X, ?Y )==== when <var>X</var> &le; <var>Y</var> and <var>Product</var> = <var>X</var> &times; <var>Y</var>. NB: Since <var>X</var>&le;<var>Y</var> it follows that <var>X</var> &le; &radic;<var>Product</var>. <pre class="prolog">ordered_factors( Z, X, Y ) :- integer_sqrt( Z, SqrtZ ), between( 2, SqrtZ, X ), Y is Z // X, between( X, 99, Y ), Z =:= X * Y.</pre> ====unique_factors( +Product )==== when <var>Product</var> has exactly one pair of factors. <pre class="prolog">unique_factors( Product ) :- ordered_factors( Product, X, _Y ), \+ (ordered_factors(Product, X1, _Y1), X1 =\= X).</pre> ====integer_sqrt( +N, ?Sqrt )==== when <var>Sqrt</var>² &le; <var>N</var> &lt; (<var>Sqrt</var>+1)². <pre class="prolog">integer_sqrt( N, Sqrt ) :- Float is N * 1.0, sqrt( Float, FSqrt ), Sqrt is integer(FSqrt).</pre> Load a small library of [[Puzzle Utilities]]. <pre class="prolog">:- ensure_loaded( misc ).</pre> The code is available as plain text [https://binding-time.co.uk/download/mister_x.txt here]. == Result == This program finds X and Y as '''4''' and '''13'''. == Tabling == Using tabling, rather than explicit lemmas, can simplify code. [https://binding-time.co.uk/download/xsb_mister_x.txt A version adapted for XSB Prolog is available here.] e26f7647c5c9b991a14a270472667eee9f1914b3 288 287 2024-03-01T20:14:34Z John 2 /* Macros */ wikitext text/x-wiki __NOTOC__ Although this problem has a straightforward solution, it does demonstrate the value of thinking deductively to understand the problem, which relates to &ldquo;don't know&rdquo; nondeterminism, and an appropriate use of lemmas. == Problem: == [https://groups.google.com/forum/#!msg/de.comp.lang.java/xQ6T3kZGqcE/-OTNgyB8yxIJ Problem as posted to comp.lang.prolog] by Thorsten Seelend. Also known as Hans Freudenthal's [[wikipedia:Impossible Puzzle|Impossible Puzzle]]. <blockquote>Mister X thinks about two integers between 1 and 100 excluding: </blockquote> =====MISTERX: Two integers, X and Y between 2 and 99 (My formalization of the given information)===== <pre class="prolog">two_integers( X, Y ) :- between( 2, 98, X ), between( X, 99, Y ).</pre> He tells Susan the Sum of them and Peter their Product. Their task is to get the two original values without telling each other the numbers that Mister X told them. <blockquote>After some time Peter says: &ldquo;I can't say definitively which are the original numbers.&rdquo;</blockquote> =====PETER1: There is more than one pair of factors giving Product===== <pre class="prolog">:- table peter1/1. peter1( Product ) :- \+ unique_factors( Product ). </pre> <blockquote>Then Susan responds: &ldquo;Neither can I, but I knew that you couldn't know it.&rdquo;</blockquote> =====SUSAN1: The product of ''every'' pair of summands giving Sum has the property PETER1===== <pre class="prolog">:- table susan1/1. susan1( Sum ) :- forall( ordered_summands(Sum, X, Y), peter1(X * Y) ). </pre> <blockquote>Peter: &ldquo;Really? So now I know the original numbers&rdquo;.</blockquote> =====PETER2: ''exactly one'' pair of factors giving Product gives a sum with the property SUSAN1===== <pre class="prolog">:- table peter2/1. peter2( Product ) :- unique_solution( (ordered_factors(Product, X, Y), susan1(X+Y)) ).</pre> <blockquote>Susan: &ldquo;Now I know them too&rdquo;.</blockquote> =====SUSAN2: ''exactly one'' pair of summands giving Sum has a product with the property PETER2===== <pre class="prolog">:- table susan2/1. susan2( Sum ) :- unique_solution( (ordered_summands(Sum, X, Y), peter2(X * Y)) ).</pre> <blockquote>Question: What are the two numbers that Mister X thought of?</blockquote> =====Unique solution===== <pre class="prolog">solve( X, Y ) :- unique_solution( mister_x(X, Y) ). mister_x( X, Y ) :- two_integers( X, Y ), Sum is X + Y, Product is X * Y, peter1( Product ), susan1( Sum ), peter2( Product ), susan2( Sum ).</pre> == Lemmas == ====lemma( +Property, +Expression )==== holds wherever <var>Property</var> holds for <var>Expression</var>. Asserted facts are used to record successful (''positive'') or failed (''negative'') demonstrations. This saves recomputation without changing the meaning of the pure program. Although the use of side-effects is generally undesirable, the use of lemmas is justified when the alternative is to compromise performance or clarity. Using lemmas or tabling to cache results is an order of magnitude faster than recalculating each property every time it is used. <pre class="prolog">:- dynamic positive/2, negative/2. lemma( Name, Expression ) :- Value is Expression, ( positive( Value, Name ) -> true ; \+ negative( Value, Name ) -> ( property(Name, Value) -> assert( positive(Value, Name) ) ; otherwise -> assert( negative(Value, Name) ), fail ) ).</pre> == Supporting Predicates == ====ordered_summands( +Sum, ?X, ?Y )==== when <var>X</var> &le; <var>Y</var> and Sum = <var>X</var>+<var>Y</var>. NB: Since <var>X</var>&le;<var>Y</var> it follows that <var>X</var> &le; <var>Sum</var>/2. <pre class="prolog">ordered_summands( Z, X, Y ) :- Half is Z//2, between( 2, Half, X ), Y is Z - X, between( X, 98, Y ).</pre> ====ordered_factors( +Product, ?X, ?Y )==== when <var>X</var> &le; <var>Y</var> and <var>Product</var> = <var>X</var> &times; <var>Y</var>. NB: Since <var>X</var>&le;<var>Y</var> it follows that <var>X</var> &le; &radic;<var>Product</var>. <pre class="prolog">ordered_factors( Z, X, Y ) :- integer_sqrt( Z, SqrtZ ), between( 2, SqrtZ, X ), Y is Z // X, between( X, 99, Y ), Z =:= X * Y.</pre> ====unique_factors( +Product )==== when <var>Product</var> has exactly one pair of factors. <pre class="prolog">unique_factors( Product ) :- ordered_factors( Product, X, _Y ), \+ (ordered_factors(Product, X1, _Y1), X1 =\= X).</pre> ====integer_sqrt( +N, ?Sqrt )==== when <var>Sqrt</var>² &le; <var>N</var> &lt; (<var>Sqrt</var>+1)². <pre class="prolog">integer_sqrt( N, Sqrt ) :- Float is N * 1.0, sqrt( Float, FSqrt ), Sqrt is integer(FSqrt).</pre> Load a small library of [[Puzzle Utilities]]. <pre class="prolog">:- ensure_loaded( misc ).</pre> The code is available as plain text [https://binding-time.co.uk/download/mister_x.txt here]. == Result == This program finds X and Y as '''4''' and '''13'''. == Tabling == Using tabling, rather than explicit lemmas, can simplify code. [https://binding-time.co.uk/download/xsb_mister_x.txt A version adapted for XSB Prolog is available here.] c6017de325654c87b6ca129a820fa58e76e4afbe 289 288 2024-03-01T20:15:01Z John 2 /* Lemmas */ wikitext text/x-wiki __NOTOC__ Although this problem has a straightforward solution, it does demonstrate the value of thinking deductively to understand the problem, which relates to &ldquo;don't know&rdquo; nondeterminism, and an appropriate use of lemmas. == Problem: == [https://groups.google.com/forum/#!msg/de.comp.lang.java/xQ6T3kZGqcE/-OTNgyB8yxIJ Problem as posted to comp.lang.prolog] by Thorsten Seelend. Also known as Hans Freudenthal's [[wikipedia:Impossible Puzzle|Impossible Puzzle]]. <blockquote>Mister X thinks about two integers between 1 and 100 excluding: </blockquote> =====MISTERX: Two integers, X and Y between 2 and 99 (My formalization of the given information)===== <pre class="prolog">two_integers( X, Y ) :- between( 2, 98, X ), between( X, 99, Y ).</pre> He tells Susan the Sum of them and Peter their Product. Their task is to get the two original values without telling each other the numbers that Mister X told them. <blockquote>After some time Peter says: &ldquo;I can't say definitively which are the original numbers.&rdquo;</blockquote> =====PETER1: There is more than one pair of factors giving Product===== <pre class="prolog">:- table peter1/1. peter1( Product ) :- \+ unique_factors( Product ). </pre> <blockquote>Then Susan responds: &ldquo;Neither can I, but I knew that you couldn't know it.&rdquo;</blockquote> =====SUSAN1: The product of ''every'' pair of summands giving Sum has the property PETER1===== <pre class="prolog">:- table susan1/1. susan1( Sum ) :- forall( ordered_summands(Sum, X, Y), peter1(X * Y) ). </pre> <blockquote>Peter: &ldquo;Really? So now I know the original numbers&rdquo;.</blockquote> =====PETER2: ''exactly one'' pair of factors giving Product gives a sum with the property SUSAN1===== <pre class="prolog">:- table peter2/1. peter2( Product ) :- unique_solution( (ordered_factors(Product, X, Y), susan1(X+Y)) ).</pre> <blockquote>Susan: &ldquo;Now I know them too&rdquo;.</blockquote> =====SUSAN2: ''exactly one'' pair of summands giving Sum has a product with the property PETER2===== <pre class="prolog">:- table susan2/1. susan2( Sum ) :- unique_solution( (ordered_summands(Sum, X, Y), peter2(X * Y)) ).</pre> <blockquote>Question: What are the two numbers that Mister X thought of?</blockquote> =====Unique solution===== <pre class="prolog">solve( X, Y ) :- unique_solution( mister_x(X, Y) ). mister_x( X, Y ) :- two_integers( X, Y ), Sum is X + Y, Product is X * Y, peter1( Product ), susan1( Sum ), peter2( Product ), susan2( Sum ).</pre> == Supporting Predicates == ====ordered_summands( +Sum, ?X, ?Y )==== when <var>X</var> &le; <var>Y</var> and Sum = <var>X</var>+<var>Y</var>. NB: Since <var>X</var>&le;<var>Y</var> it follows that <var>X</var> &le; <var>Sum</var>/2. <pre class="prolog">ordered_summands( Z, X, Y ) :- Half is Z//2, between( 2, Half, X ), Y is Z - X, between( X, 98, Y ).</pre> ====ordered_factors( +Product, ?X, ?Y )==== when <var>X</var> &le; <var>Y</var> and <var>Product</var> = <var>X</var> &times; <var>Y</var>. NB: Since <var>X</var>&le;<var>Y</var> it follows that <var>X</var> &le; &radic;<var>Product</var>. <pre class="prolog">ordered_factors( Z, X, Y ) :- integer_sqrt( Z, SqrtZ ), between( 2, SqrtZ, X ), Y is Z // X, between( X, 99, Y ), Z =:= X * Y.</pre> ====unique_factors( +Product )==== when <var>Product</var> has exactly one pair of factors. <pre class="prolog">unique_factors( Product ) :- ordered_factors( Product, X, _Y ), \+ (ordered_factors(Product, X1, _Y1), X1 =\= X).</pre> ====integer_sqrt( +N, ?Sqrt )==== when <var>Sqrt</var>² &le; <var>N</var> &lt; (<var>Sqrt</var>+1)². <pre class="prolog">integer_sqrt( N, Sqrt ) :- Float is N * 1.0, sqrt( Float, FSqrt ), Sqrt is integer(FSqrt).</pre> Load a small library of [[Puzzle Utilities]]. <pre class="prolog">:- ensure_loaded( misc ).</pre> The code is available as plain text [https://binding-time.co.uk/download/mister_x.txt here]. == Result == This program finds X and Y as '''4''' and '''13'''. == Tabling == Using tabling, rather than explicit lemmas, can simplify code. [https://binding-time.co.uk/download/xsb_mister_x.txt A version adapted for XSB Prolog is available here.] 1ecf8dae05fbac50db7675927b3a2e020f43d5e1 290 289 2024-03-01T20:17:11Z John 2 /* integer_sqrt( +N, ?Sqrt ) */ wikitext text/x-wiki __NOTOC__ Although this problem has a straightforward solution, it does demonstrate the value of thinking deductively to understand the problem, which relates to &ldquo;don't know&rdquo; nondeterminism, and an appropriate use of lemmas. == Problem: == [https://groups.google.com/forum/#!msg/de.comp.lang.java/xQ6T3kZGqcE/-OTNgyB8yxIJ Problem as posted to comp.lang.prolog] by Thorsten Seelend. Also known as Hans Freudenthal's [[wikipedia:Impossible Puzzle|Impossible Puzzle]]. <blockquote>Mister X thinks about two integers between 1 and 100 excluding: </blockquote> =====MISTERX: Two integers, X and Y between 2 and 99 (My formalization of the given information)===== <pre class="prolog">two_integers( X, Y ) :- between( 2, 98, X ), between( X, 99, Y ).</pre> He tells Susan the Sum of them and Peter their Product. Their task is to get the two original values without telling each other the numbers that Mister X told them. <blockquote>After some time Peter says: &ldquo;I can't say definitively which are the original numbers.&rdquo;</blockquote> =====PETER1: There is more than one pair of factors giving Product===== <pre class="prolog">:- table peter1/1. peter1( Product ) :- \+ unique_factors( Product ). </pre> <blockquote>Then Susan responds: &ldquo;Neither can I, but I knew that you couldn't know it.&rdquo;</blockquote> =====SUSAN1: The product of ''every'' pair of summands giving Sum has the property PETER1===== <pre class="prolog">:- table susan1/1. susan1( Sum ) :- forall( ordered_summands(Sum, X, Y), peter1(X * Y) ). </pre> <blockquote>Peter: &ldquo;Really? So now I know the original numbers&rdquo;.</blockquote> =====PETER2: ''exactly one'' pair of factors giving Product gives a sum with the property SUSAN1===== <pre class="prolog">:- table peter2/1. peter2( Product ) :- unique_solution( (ordered_factors(Product, X, Y), susan1(X+Y)) ).</pre> <blockquote>Susan: &ldquo;Now I know them too&rdquo;.</blockquote> =====SUSAN2: ''exactly one'' pair of summands giving Sum has a product with the property PETER2===== <pre class="prolog">:- table susan2/1. susan2( Sum ) :- unique_solution( (ordered_summands(Sum, X, Y), peter2(X * Y)) ).</pre> <blockquote>Question: What are the two numbers that Mister X thought of?</blockquote> =====Unique solution===== <pre class="prolog">solve( X, Y ) :- unique_solution( mister_x(X, Y) ). mister_x( X, Y ) :- two_integers( X, Y ), Sum is X + Y, Product is X * Y, peter1( Product ), susan1( Sum ), peter2( Product ), susan2( Sum ).</pre> == Supporting Predicates == ====ordered_summands( +Sum, ?X, ?Y )==== when <var>X</var> &le; <var>Y</var> and Sum = <var>X</var>+<var>Y</var>. NB: Since <var>X</var>&le;<var>Y</var> it follows that <var>X</var> &le; <var>Sum</var>/2. <pre class="prolog">ordered_summands( Z, X, Y ) :- Half is Z//2, between( 2, Half, X ), Y is Z - X, between( X, 98, Y ).</pre> ====ordered_factors( +Product, ?X, ?Y )==== when <var>X</var> &le; <var>Y</var> and <var>Product</var> = <var>X</var> &times; <var>Y</var>. NB: Since <var>X</var>&le;<var>Y</var> it follows that <var>X</var> &le; &radic;<var>Product</var>. <pre class="prolog">ordered_factors( Z, X, Y ) :- integer_sqrt( Z, SqrtZ ), between( 2, SqrtZ, X ), Y is Z // X, between( X, 99, Y ), Z =:= X * Y.</pre> ====unique_factors( +Product )==== when <var>Product</var> has exactly one pair of factors. <pre class="prolog">unique_factors( Product ) :- ordered_factors( Product, X, _Y ), \+ (ordered_factors(Product, X1, _Y1), X1 =\= X).</pre> ====integer_sqrt( +N, ?Sqrt )==== when <var>Sqrt</var>² &le; <var>N</var> &lt; (<var>Sqrt</var>+1)². <pre class="prolog">integer_sqrt( N, Sqrt ) :- Sqrt is floor(sqrt(N)).</pre> Load a small library of [[Puzzle Utilities]]. <pre class="prolog">:- ensure_loaded( misc ).</pre> == Result == This program finds X and Y as '''4''' and '''13'''. == Tabling == Using tabling, rather than explicit lemmas, can simplify code. [https://binding-time.co.uk/download/xsb_mister_x.txt A version adapted for XSB Prolog is available here.] 02d949840042091c5df5409cdaddd7c190e7c01d 291 290 2024-03-01T20:17:50Z John 2 /* Tabling */ wikitext text/x-wiki __NOTOC__ Although this problem has a straightforward solution, it does demonstrate the value of thinking deductively to understand the problem, which relates to &ldquo;don't know&rdquo; nondeterminism, and an appropriate use of lemmas. == Problem: == [https://groups.google.com/forum/#!msg/de.comp.lang.java/xQ6T3kZGqcE/-OTNgyB8yxIJ Problem as posted to comp.lang.prolog] by Thorsten Seelend. Also known as Hans Freudenthal's [[wikipedia:Impossible Puzzle|Impossible Puzzle]]. <blockquote>Mister X thinks about two integers between 1 and 100 excluding: </blockquote> =====MISTERX: Two integers, X and Y between 2 and 99 (My formalization of the given information)===== <pre class="prolog">two_integers( X, Y ) :- between( 2, 98, X ), between( X, 99, Y ).</pre> He tells Susan the Sum of them and Peter their Product. Their task is to get the two original values without telling each other the numbers that Mister X told them. <blockquote>After some time Peter says: &ldquo;I can't say definitively which are the original numbers.&rdquo;</blockquote> =====PETER1: There is more than one pair of factors giving Product===== <pre class="prolog">:- table peter1/1. peter1( Product ) :- \+ unique_factors( Product ). </pre> <blockquote>Then Susan responds: &ldquo;Neither can I, but I knew that you couldn't know it.&rdquo;</blockquote> =====SUSAN1: The product of ''every'' pair of summands giving Sum has the property PETER1===== <pre class="prolog">:- table susan1/1. susan1( Sum ) :- forall( ordered_summands(Sum, X, Y), peter1(X * Y) ). </pre> <blockquote>Peter: &ldquo;Really? So now I know the original numbers&rdquo;.</blockquote> =====PETER2: ''exactly one'' pair of factors giving Product gives a sum with the property SUSAN1===== <pre class="prolog">:- table peter2/1. peter2( Product ) :- unique_solution( (ordered_factors(Product, X, Y), susan1(X+Y)) ).</pre> <blockquote>Susan: &ldquo;Now I know them too&rdquo;.</blockquote> =====SUSAN2: ''exactly one'' pair of summands giving Sum has a product with the property PETER2===== <pre class="prolog">:- table susan2/1. susan2( Sum ) :- unique_solution( (ordered_summands(Sum, X, Y), peter2(X * Y)) ).</pre> <blockquote>Question: What are the two numbers that Mister X thought of?</blockquote> =====Unique solution===== <pre class="prolog">solve( X, Y ) :- unique_solution( mister_x(X, Y) ). mister_x( X, Y ) :- two_integers( X, Y ), Sum is X + Y, Product is X * Y, peter1( Product ), susan1( Sum ), peter2( Product ), susan2( Sum ).</pre> == Supporting Predicates == ====ordered_summands( +Sum, ?X, ?Y )==== when <var>X</var> &le; <var>Y</var> and Sum = <var>X</var>+<var>Y</var>. NB: Since <var>X</var>&le;<var>Y</var> it follows that <var>X</var> &le; <var>Sum</var>/2. <pre class="prolog">ordered_summands( Z, X, Y ) :- Half is Z//2, between( 2, Half, X ), Y is Z - X, between( X, 98, Y ).</pre> ====ordered_factors( +Product, ?X, ?Y )==== when <var>X</var> &le; <var>Y</var> and <var>Product</var> = <var>X</var> &times; <var>Y</var>. NB: Since <var>X</var>&le;<var>Y</var> it follows that <var>X</var> &le; &radic;<var>Product</var>. <pre class="prolog">ordered_factors( Z, X, Y ) :- integer_sqrt( Z, SqrtZ ), between( 2, SqrtZ, X ), Y is Z // X, between( X, 99, Y ), Z =:= X * Y.</pre> ====unique_factors( +Product )==== when <var>Product</var> has exactly one pair of factors. <pre class="prolog">unique_factors( Product ) :- ordered_factors( Product, X, _Y ), \+ (ordered_factors(Product, X1, _Y1), X1 =\= X).</pre> ====integer_sqrt( +N, ?Sqrt )==== when <var>Sqrt</var>² &le; <var>N</var> &lt; (<var>Sqrt</var>+1)². <pre class="prolog">integer_sqrt( N, Sqrt ) :- Sqrt is floor(sqrt(N)).</pre> Load a small library of [[Puzzle Utilities]]. <pre class="prolog">:- ensure_loaded( misc ).</pre> == Result == This program finds X and Y as '''4''' and '''13'''. 952203ed7681797c1c77e37535b1772289245516 292 291 2024-03-01T20:42:01Z John 2 wikitext text/x-wiki __NOTOC__ Although this problem has a straightforward solution, it does demonstrate the value of thinking deductively to understand the problem, which relates to &ldquo;don't know&rdquo; nondeterminism, and an appropriate use of lemmas. == Problem: == [https://groups.google.com/forum/#!msg/de.comp.lang.java/xQ6T3kZGqcE/-OTNgyB8yxIJ Problem as posted to comp.lang.prolog] by Thorsten Seelend. Also known as Hans Freudenthal's [[wikipedia:Impossible Puzzle|Impossible Puzzle]]. <blockquote>Mister X thinks about two integers between 1 and 100 excluding: </blockquote> =====MISTERX: Two integers, X and Y between 2 and 99 (My formalization of the given information)===== <pre class="prolog">two_integers( X, Y ) :- between( 2, 98, X ), between( X, 99, Y ).</pre> He tells Susan the Sum of them and Peter their Product. Their task is to get the two original values without telling each other the numbers that Mister X told them. <blockquote>After some time Peter says: &ldquo;I can't say definitively which are the original numbers.&rdquo;</blockquote> =====PETER1: There is more than one pair of factors giving Product===== <pre class="prolog">:- table peter1/1. peter1( Product ) :- \+ unique_factors( Product ). </pre> <blockquote>Then Susan responds: &ldquo;Neither can I, but I knew that you couldn't know it.&rdquo;</blockquote> =====SUSAN1: The product of ''every'' pair of summands giving Sum has the property PETER1===== <pre class="prolog">:- table susan1/1. susan1( Sum ) :- forall( ordered_summands(Sum, X, Y), peter1(X * Y) ). </pre> <blockquote>Peter: &ldquo;Really? So now I know the original numbers&rdquo;.</blockquote> =====PETER2: ''exactly one'' pair of factors giving Product gives a sum with the property SUSAN1===== <pre class="prolog">:- table peter2/1. peter2( Product ) :- unique_solution( (ordered_factors(Product, X, Y), susan1(X+Y)) ).</pre> <blockquote>Susan: &ldquo;Now I know them too&rdquo;.</blockquote> =====SUSAN2: ''exactly one'' pair of summands giving Sum has a product with the property PETER2===== <pre class="prolog">:- table susan2/1. susan2( Sum ) :- unique_solution( (ordered_summands(Sum, X, Y), peter2(X * Y)) ).</pre> <blockquote>Question: What are the two numbers that Mister X thought of?</blockquote> =====Unique solution===== <pre class="prolog">solve( X, Y ) :- unique_solution( mister_x(X, Y) ). mister_x( X, Y ) :- two_integers( X, Y ), Sum is X + Y, Product is X * Y, peter1( Product ), susan1( Sum ), peter2( Product ), susan2( Sum ).</pre> == Supporting Predicates == ====ordered_summands( +Sum, ?X, ?Y )==== when <var>X</var> &le; <var>Y</var> and Sum = <var>X</var>+<var>Y</var>. NB: Since <var>X</var>&le;<var>Y</var> it follows that <var>X</var> &le; <var>Sum</var>/2. <pre class="prolog">ordered_summands( Z, X, Y ) :- Half is Z//2, between( 2, Half, X ), Y is Z - X, between( X, 98, Y ).</pre> ====ordered_factors( +Product, ?X, ?Y )==== when <var>X</var> &le; <var>Y</var> and <var>Product</var> = <var>X</var> &times; <var>Y</var>. NB: Since <var>X</var>&le;<var>Y</var> it follows that <var>X</var> &le; &radic;<var>Product</var>. <pre class="prolog">ordered_factors( Z, X, Y ) :- integer_sqrt( Z, SqrtZ ), between( 2, SqrtZ, X ), Y is Z // X, between( X, 99, Y ), Z =:= X * Y.</pre> ====unique_factors( +Product )==== when <var>Product</var> has exactly one pair of factors. <pre class="prolog">unique_factors( Product ) :- ordered_factors( Product, X, _Y ), \+ (ordered_factors(Product, X1, _Y1), X1 =\= X).</pre> ====integer_sqrt( +N, ?Sqrt )==== when <var>Sqrt</var>² &le; <var>N</var> &lt; (<var>Sqrt</var>+1)². <pre class="prolog">integer_sqrt( N, Sqrt ) :- Sqrt is floor(sqrt(N)).</pre> == Utility Predicates == Load a small library of [[Puzzle Utilities]]. <pre class="prolog">:- ensure_loaded( misc ).</pre> == Result == This program finds X and Y as '''4''' and '''13'''. 1a4e3e67027a27cd863da3f094ed2c64e0e7f6c8